From 1eded1a3f64952882919e43db536613be73d55ed Mon Sep 17 00:00:00 2001 From: Camm Maguire Date: Sat, 28 Nov 2020 15:50:42 +0000 Subject: [PATCH] Import gcl_2.6.12-99.debian.tar.xz [dgit import tarball gcl 2.6.12-99 gcl_2.6.12-99.debian.tar.xz] --- README.Debian | 28 + changelog | 4038 ++++ compat | 1 + control | 39 + control. | 39 + control.cvs | 39 + copyright | 65 + gcl.lintian-overrides | 9 + gcl.sh | 28 + gcl.templates | 38 + in.gcl-doc.README.Debian | 9 + in.gcl-doc.doc-base.si | 12 + in.gcl-doc.doc-base.tk | 12 + in.gcl-doc.doc-base.xgcl | 15 + in.gcl-doc.docs | 3 + in.gcl-doc.info | 4 + in.gcl-doc.install | 1 + in.gcl.config | 19 + in.gcl.docs | 2 + in.gcl.emacsen-compat | 1 + in.gcl.emacsen-install | 46 + in.gcl.emacsen-remove | 15 + in.gcl.emacsen-startup | 19 + in.gcl.install | 3 + in.gcl.manpages | 1 + in.gcl.postinst | 40 + in.gcl.postrm | 22 + old.in.gcl-doc.doc-base.main | 12 + patches/Version_2_6_13pre1 | 13167 +++++++++++ patches/Version_2_6_13pre12 | 1168 + patches/Version_2_6_13pre13 | 103 + patches/Version_2_6_13pre16 | 2585 +++ patches/Version_2_6_13pre17 | 76 + patches/Version_2_6_13pre18 | 573 + patches/Version_2_6_13pre19 | 92 + patches/Version_2_6_13pre1a | 86 + patches/Version_2_6_13pre1b | 36 + patches/Version_2_6_13pre2 | 229 + patches/Version_2_6_13pre20 | 45 + patches/Version_2_6_13pre22 | 357 + patches/Version_2_6_13pre25 | 185 + patches/Version_2_6_13pre26 | 235 + patches/Version_2_6_13pre27 | 161 + patches/Version_2_6_13pre28 | 353 + patches/Version_2_6_13pre29 | 47 + patches/Version_2_6_13pre3 | 124 + patches/Version_2_6_13pre30 | 111 + patches/Version_2_6_13pre31 | 115 + patches/Version_2_6_13pre32 | 57 + patches/Version_2_6_13pre33 | 232 + patches/Version_2_6_13pre34 | 34 + patches/Version_2_6_13pre35 | 40 + patches/Version_2_6_13pre36 | 89 + patches/Version_2_6_13pre38 | 308 + patches/Version_2_6_13pre39 | 53 + patches/Version_2_6_13pre3a | 62 + patches/Version_2_6_13pre4 | 647 + patches/Version_2_6_13pre41 | 185 + patches/Version_2_6_13pre45 | 253 + patches/Version_2_6_13pre46 | 237 + patches/Version_2_6_13pre47 | 36 + patches/Version_2_6_13pre48 | 59 + patches/Version_2_6_13pre49 | 33 + patches/Version_2_6_13pre5 | 83 + patches/Version_2_6_13pre50 | 223 + patches/Version_2_6_13pre52 | 36 + patches/Version_2_6_13pre54 | 2878 +++ patches/Version_2_6_13pre55 | 132 + patches/Version_2_6_13pre56 | 107 + patches/Version_2_6_13pre57 | 36 + patches/Version_2_6_13pre58 | 86 + patches/Version_2_6_13pre59 | 88 + patches/Version_2_6_13pre6 | 156 + patches/Version_2_6_13pre60 | 61 + patches/Version_2_6_13pre61 | 45 + patches/Version_2_6_13pre62 | 113 + patches/Version_2_6_13pre63 | 78 + patches/Version_2_6_13pre64 | 169 + patches/Version_2_6_13pre65 | 212 + patches/Version_2_6_13pre66 | 132 + patches/Version_2_6_13pre67 | 256 + patches/Version_2_6_13pre68 | 35 + patches/Version_2_6_13pre69 | 32 + patches/Version_2_6_13pre7 | 163 + patches/Version_2_6_13pre70 | 108 + patches/Version_2_6_13pre71 | 59 + patches/Version_2_6_13pre72 | 103 + patches/Version_2_6_13pre73 | 130 + patches/Version_2_6_13pre74 | 47 + patches/Version_2_6_13pre76 | 446 + patches/Version_2_6_13pre77 | 71 + patches/Version_2_6_13pre78 | 38 + patches/Version_2_6_13pre79 | 47 + patches/Version_2_6_13pre80 | 111 + patches/Version_2_6_13pre81 | 71 + patches/Version_2_6_13pre82 | 40 + patches/Version_2_6_13pre83 | 446 + patches/Version_2_6_13pre84 | 45 + patches/Version_2_6_13pre85 | 123 + patches/Version_2_6_13pre86 | 45 + patches/Version_2_6_13pre87 | 89 + patches/Version_2_6_13pre88 | 151 + patches/Version_2_6_13pre89 | 277 + patches/Version_2_6_13pre8a | 1359 ++ patches/Version_2_6_13pre8b | 43 + patches/Version_2_6_13pre90 | 90 + patches/Version_2_6_13pre92 | 53 + patches/Version_2_6_13pre94 | 39 + patches/Version_2_6_13pre95 | 67 + patches/ansi-test-clean-target | 33 + patches/data_bss_offset-in-unexec-sparc64-fix | 83 + patches/defined_real_maxpage | 71 + patches/disable_gprof_aarch64 | 56 + patches/list_order.1 | 8651 +++++++ patches/list_order.11 | 600 + patches/list_order.12 | 50 + patches/list_order.13 | 36 + patches/list_order.16 | 412 + patches/list_order.17 | 1136 + patches/list_order.18 | 60 + patches/list_order.19 | 218 + patches/list_order.20 | 72 + patches/list_order.21 | 48 + patches/list_order.22 | 62 + patches/list_order.23 | 85 + patches/list_order.24 | 44 + patches/list_order.25 | 81 + patches/list_order.4 | 36 + patches/list_order.5 | 205 + patches/list_order.6 | 103 + patches/list_order.7 | 47 + patches/list_order.8 | 78 + patches/list_order.9 | 146 + patches/pathnames1.1 | 18763 ++++++++++++++++ patches/pathnames1.11 | 246 + patches/pathnames1.12 | 68 + patches/pathnames1.13 | 40 + patches/pathnames1.2 | 1196 + patches/pathnames1.3 | 48 + patches/pathnames1.4 | 36 + patches/pathnames1.5 | 10494 +++++++++ patches/pathnames1.6 | 42 + patches/pathnames1.7 | 601 + patches/pathnames1.9 | 5609 +++++ patches/real_list_order.12 | 159 + patches/series | 117 + po/POTFILES.in | 1 + po/cs.po | 139 + po/da.po | 97 + po/de.po | 139 + po/es.po | 209 + po/fi.po | 95 + po/fr.po | 141 + po/gl.po | 138 + po/it.po | 102 + po/ja.po | 96 + po/nl.po | 101 + po/pt.po | 99 + po/pt_BR.po | 98 + po/ru.po | 100 + po/sv.po | 106 + po/templates.pot | 82 + po/vi.po | 98 + rules | 271 + source/format | 1 + source/include-binaries | 4 + texi.awk | 27 + upstream/signing-key.asc | 88 + watch | 2 + 169 files changed, 88018 insertions(+) create mode 100644 README.Debian create mode 100644 changelog create mode 100644 compat create mode 100644 control create mode 100644 control. create mode 100644 control.cvs create mode 100644 copyright create mode 100644 gcl.lintian-overrides create mode 100755 gcl.sh create mode 100644 gcl.templates create mode 100644 in.gcl-doc.README.Debian create mode 100644 in.gcl-doc.doc-base.si create mode 100644 in.gcl-doc.doc-base.tk create mode 100644 in.gcl-doc.doc-base.xgcl create mode 100644 in.gcl-doc.docs create mode 100644 in.gcl-doc.info create mode 100644 in.gcl-doc.install create mode 100644 in.gcl.config create mode 100644 in.gcl.docs create mode 100644 in.gcl.emacsen-compat create mode 100644 in.gcl.emacsen-install create mode 100644 in.gcl.emacsen-remove create mode 100644 in.gcl.emacsen-startup create mode 100644 in.gcl.install create mode 100644 in.gcl.manpages create mode 100644 in.gcl.postinst create mode 100644 in.gcl.postrm create mode 100644 old.in.gcl-doc.doc-base.main create mode 100644 patches/Version_2_6_13pre1 create mode 100644 patches/Version_2_6_13pre12 create mode 100644 patches/Version_2_6_13pre13 create mode 100644 patches/Version_2_6_13pre16 create mode 100644 patches/Version_2_6_13pre17 create mode 100644 patches/Version_2_6_13pre18 create mode 100644 patches/Version_2_6_13pre19 create mode 100644 patches/Version_2_6_13pre1a create mode 100644 patches/Version_2_6_13pre1b create mode 100644 patches/Version_2_6_13pre2 create mode 100644 patches/Version_2_6_13pre20 create mode 100644 patches/Version_2_6_13pre22 create mode 100644 patches/Version_2_6_13pre25 create mode 100644 patches/Version_2_6_13pre26 create mode 100644 patches/Version_2_6_13pre27 create mode 100644 patches/Version_2_6_13pre28 create mode 100644 patches/Version_2_6_13pre29 create mode 100644 patches/Version_2_6_13pre3 create mode 100644 patches/Version_2_6_13pre30 create mode 100644 patches/Version_2_6_13pre31 create mode 100644 patches/Version_2_6_13pre32 create mode 100644 patches/Version_2_6_13pre33 create mode 100644 patches/Version_2_6_13pre34 create mode 100644 patches/Version_2_6_13pre35 create mode 100644 patches/Version_2_6_13pre36 create mode 100644 patches/Version_2_6_13pre38 create mode 100644 patches/Version_2_6_13pre39 create mode 100644 patches/Version_2_6_13pre3a create mode 100644 patches/Version_2_6_13pre4 create mode 100644 patches/Version_2_6_13pre41 create mode 100644 patches/Version_2_6_13pre45 create mode 100644 patches/Version_2_6_13pre46 create mode 100644 patches/Version_2_6_13pre47 create mode 100644 patches/Version_2_6_13pre48 create mode 100644 patches/Version_2_6_13pre49 create mode 100644 patches/Version_2_6_13pre5 create mode 100644 patches/Version_2_6_13pre50 create mode 100644 patches/Version_2_6_13pre52 create mode 100644 patches/Version_2_6_13pre54 create mode 100644 patches/Version_2_6_13pre55 create mode 100644 patches/Version_2_6_13pre56 create mode 100644 patches/Version_2_6_13pre57 create mode 100644 patches/Version_2_6_13pre58 create mode 100644 patches/Version_2_6_13pre59 create mode 100644 patches/Version_2_6_13pre6 create mode 100644 patches/Version_2_6_13pre60 create mode 100644 patches/Version_2_6_13pre61 create mode 100644 patches/Version_2_6_13pre62 create mode 100644 patches/Version_2_6_13pre63 create mode 100644 patches/Version_2_6_13pre64 create mode 100644 patches/Version_2_6_13pre65 create mode 100644 patches/Version_2_6_13pre66 create mode 100644 patches/Version_2_6_13pre67 create mode 100644 patches/Version_2_6_13pre68 create mode 100644 patches/Version_2_6_13pre69 create mode 100644 patches/Version_2_6_13pre7 create mode 100644 patches/Version_2_6_13pre70 create mode 100644 patches/Version_2_6_13pre71 create mode 100644 patches/Version_2_6_13pre72 create mode 100644 patches/Version_2_6_13pre73 create mode 100644 patches/Version_2_6_13pre74 create mode 100644 patches/Version_2_6_13pre76 create mode 100644 patches/Version_2_6_13pre77 create mode 100644 patches/Version_2_6_13pre78 create mode 100644 patches/Version_2_6_13pre79 create mode 100644 patches/Version_2_6_13pre80 create mode 100644 patches/Version_2_6_13pre81 create mode 100644 patches/Version_2_6_13pre82 create mode 100644 patches/Version_2_6_13pre83 create mode 100644 patches/Version_2_6_13pre84 create mode 100644 patches/Version_2_6_13pre85 create mode 100644 patches/Version_2_6_13pre86 create mode 100644 patches/Version_2_6_13pre87 create mode 100644 patches/Version_2_6_13pre88 create mode 100644 patches/Version_2_6_13pre89 create mode 100644 patches/Version_2_6_13pre8a create mode 100644 patches/Version_2_6_13pre8b create mode 100644 patches/Version_2_6_13pre90 create mode 100644 patches/Version_2_6_13pre92 create mode 100644 patches/Version_2_6_13pre94 create mode 100644 patches/Version_2_6_13pre95 create mode 100644 patches/ansi-test-clean-target create mode 100644 patches/data_bss_offset-in-unexec-sparc64-fix create mode 100644 patches/defined_real_maxpage create mode 100644 patches/disable_gprof_aarch64 create mode 100644 patches/list_order.1 create mode 100644 patches/list_order.11 create mode 100644 patches/list_order.12 create mode 100644 patches/list_order.13 create mode 100644 patches/list_order.16 create mode 100644 patches/list_order.17 create mode 100644 patches/list_order.18 create mode 100644 patches/list_order.19 create mode 100644 patches/list_order.20 create mode 100644 patches/list_order.21 create mode 100644 patches/list_order.22 create mode 100644 patches/list_order.23 create mode 100644 patches/list_order.24 create mode 100644 patches/list_order.25 create mode 100644 patches/list_order.4 create mode 100644 patches/list_order.5 create mode 100644 patches/list_order.6 create mode 100644 patches/list_order.7 create mode 100644 patches/list_order.8 create mode 100644 patches/list_order.9 create mode 100644 patches/pathnames1.1 create mode 100644 patches/pathnames1.11 create mode 100644 patches/pathnames1.12 create mode 100644 patches/pathnames1.13 create mode 100644 patches/pathnames1.2 create mode 100644 patches/pathnames1.3 create mode 100644 patches/pathnames1.4 create mode 100644 patches/pathnames1.5 create mode 100644 patches/pathnames1.6 create mode 100644 patches/pathnames1.7 create mode 100644 patches/pathnames1.9 create mode 100644 patches/real_list_order.12 create mode 100644 patches/series create mode 100644 po/POTFILES.in create mode 100644 po/cs.po create mode 100644 po/da.po create mode 100644 po/de.po create mode 100644 po/es.po create mode 100644 po/fi.po create mode 100644 po/fr.po create mode 100644 po/gl.po create mode 100644 po/it.po create mode 100644 po/ja.po create mode 100644 po/nl.po create mode 100644 po/pt.po create mode 100644 po/pt_BR.po create mode 100644 po/ru.po create mode 100644 po/sv.po create mode 100644 po/templates.pot create mode 100644 po/vi.po create mode 100755 rules create mode 100644 source/format create mode 100644 source/include-binaries create mode 100755 texi.awk create mode 100644 upstream/signing-key.asc create mode 100644 watch diff --git a/README.Debian b/README.Debian new file mode 100644 index 00000000..81749750 --- /dev/null +++ b/README.Debian @@ -0,0 +1,28 @@ +The Debian package gcl +---------------------- + +GCL is one of the oldest free common lisp systems still in use. Several +production systems have used it for over a decade. The common lisp +standard in effect when GCL was first released is known as "Common Lisp, +the Language" (CLtL1) after a book by Steele of the same name providing +this specification. Subsequently, a much expanded standard was adopted by +the American National Standards Institute (ANSI), which is still +considered the definitive common lisp language specification to this day. + +Debian GCL now installs both the small 'traditional' lisp image +designed to conform to a pre-ANSI Lisp standard, and an experimental +ANSI image. Please note that ANSI support in GCL is still +preliminary. On an ansi-test suite written by a GCL developer, GCL +fails on a little under 3 percent of the tests. Details can be found +in /usr/share/doc/gcl/test_results.gz. + +To toggle the use of the ANSI image, set the environment variable +GCL_ANSI to any non-empty string. + +New in 2.6.2 +------------ + +Please see the RELEASE-2.6.2.html file for release note information, +regression testing, and sample benchmarks. + + -- Camm Maguire , Wed Dec 14 18:55:19 2005 diff --git a/changelog b/changelog new file mode 100644 index 00000000..6513f269 --- /dev/null +++ b/changelog @@ -0,0 +1,4038 @@ +gcl (2.6.12-99) unstable; urgency=medium + + * Version_2.6.13pre95 + + -- Camm Maguire Sat, 28 Nov 2020 15:50:42 +0000 + +gcl (2.6.12-98) unstable; urgency=medium + + * Version_2.6.13pre94 + + -- Camm Maguire Tue, 29 Sep 2020 18:29:10 +0000 + +gcl (2.6.12-97) unstable; urgency=medium + + * Bug fix: "Removal of obsolete debhelper compat 5 and 6 in bookworm", + thanks to Niels Thykier (Closes: #965543). + * Version_2.6.13pre93 + + -- Camm Maguire Sat, 29 Aug 2020 16:23:07 +0000 + +gcl (2.6.12-96) unstable; urgency=high + + * Version_2.6.13pre92: Work around armhf strip bug producing undefined + instruction in .plt + + -- Camm Maguire Sun, 23 Aug 2020 17:53:14 +0000 + +gcl (2.6.12-95) unstable; urgency=high + + * Version_2_6_13pre90 + * build under GCL_MEM_MULTIPLE=0.1 + * Bug fix: "FTBFS: Unrecoverable error: Segmentation violation..", + thanks to Lucas Nussbaum (Closes: #952334). + + -- Camm Maguire Fri, 01 May 2020 12:55:02 +0000 + +gcl (2.6.12-94) unstable; urgency=medium + + * re-release to overcome hopefully transient buildd failure + + -- Camm Maguire Mon, 24 Feb 2020 20:02:52 +0000 + +gcl (2.6.12-93) unstable; urgency=medium + + * Version_2_6_13pre90 + + -- Camm Maguire Fri, 21 Feb 2020 19:06:56 +0000 + +gcl (2.6.12-92) unstable; urgency=medium + + * Version_2_6_13pre89 + + -- Camm Maguire Mon, 30 Dec 2019 15:46:22 +0000 + +gcl (2.6.12-91) unstable; urgency=medium + + * Version_2_6_13pre88 + + -- Camm Maguire Wed, 18 Dec 2019 20:14:09 +0000 + +gcl (2.6.12-90) unstable; urgency=medium + + * Version_2_6_13pre87 + * latest standards + + -- Camm Maguire Sun, 08 Dec 2019 19:27:24 +0000 + +gcl (2.6.12-89) unstable; urgency=medium + + * Bug fix: "gcl - FTBFS on ppc64el - invalid relocation type 31", thanks + to thierry.fauck@fr.ibm.com; (Closes: #942312). + * Bug fix: "FTBFS on ppc64el", thanks to Ivo De Decker (Closes: + #944651). + + -- Camm Maguire Sat, 07 Dec 2019 23:27:53 +0000 + +gcl (2.6.12-88) unstable; urgency=medium + + * Source only upload + + -- Camm Maguire Fri, 11 Oct 2019 19:18:44 +0000 + +gcl (2.6.12-87) unstable; urgency=medium + + * Version_2_6_13pre84 + + -- Camm Maguire Sat, 06 Apr 2019 13:03:21 +0000 + +gcl (2.6.12-86) unstable; urgency=medium + + * Version_2_6_13pre83 + + -- Camm Maguire Tue, 02 Apr 2019 19:57:15 +0000 + +gcl (2.6.12-85) unstable; urgency=medium + + * Version_2_6_13pre82 + + -- Camm Maguire Thu, 28 Mar 2019 18:48:55 +0000 + +gcl (2.6.12-84) unstable; urgency=medium + + * Version_2_6_13pre80 + + -- Camm Maguire Thu, 21 Mar 2019 18:59:40 +0000 + +gcl (2.6.12-83) unstable; urgency=high + + * Version_2_6_13pre79 + * Fix acl2 arm builds (Closes: #919477). + + -- Camm Maguire Tue, 05 Feb 2019 21:54:42 +0000 + +gcl (2.6.12-82) unstable; urgency=high + + * Version_2_6_13pre74 + + -- Camm Maguire Sat, 02 Feb 2019 17:40:20 +0000 + +gcl (2.6.12-81) unstable; urgency=high + + * Version_2_6_13pre72 + * Fix to ppc64el for acl2 FTBFS bug + + -- Camm Maguire Mon, 21 Jan 2019 16:40:36 +0000 + +gcl (2.6.12-80) unstable; urgency=medium + + * Version_2_6_13pre71 + * Bug fix: "FTBFS on hppa - segmentation fault assembling gbc.s", thanks + to John David Anglin (Closes: #912071). + + -- Camm Maguire Tue, 30 Oct 2018 17:20:43 +0000 + +gcl (2.6.12-79) unstable; urgency=medium + + * Version_2_6_13pre70 + + -- Camm Maguire Mon, 29 Oct 2018 16:52:17 +0000 + +gcl (2.6.12-78) unstable; urgency=medium + + * rebuild against latest compilers and tools + * Version_2_6_13pre69 + + -- Camm Maguire Thu, 11 Oct 2018 16:40:48 +0000 + +gcl (2.6.12-77) unstable; urgency=medium + + * Version_2_6_13pre68 + * Bug fix: "GCL fails to load .o files it generates", thanks to Gong-Yi + Liao (Closes: #902475). Add support for R_X86_64_PLT32 relocs. + + -- Camm Maguire Tue, 24 Jul 2018 20:06:45 +0000 + +gcl (2.6.12-76) unstable; urgency=medium + + * Version_2_6_13pre67 + + -- Camm Maguire Fri, 23 Mar 2018 19:25:22 +0000 + +gcl (2.6.12-75) unstable; urgency=medium + + * Version_2_6_13pre65 + + -- Camm Maguire Wed, 21 Mar 2018 20:28:08 +0000 + +gcl (2.6.12-74) unstable; urgency=medium + + * Version_2_6_13pre63 + + -- Camm Maguire Sat, 17 Mar 2018 11:56:05 +0000 + +gcl (2.6.12-73) unstable; urgency=medium + + * Version_2_6_13pre62 + + -- Camm Maguire Wed, 14 Mar 2018 15:38:43 +0000 + +gcl (2.6.12-72) unstable; urgency=medium + + * Version_2_6_13pre61 + + -- Camm Maguire Tue, 13 Mar 2018 15:32:44 +0000 + +gcl (2.6.12-71) unstable; urgency=medium + + * Version_2_6_13pre60 + + -- Camm Maguire Mon, 12 Mar 2018 19:44:47 +0000 + +gcl (2.6.12-70) unstable; urgency=medium + + * Version_2_6_13pre59 + + -- Camm Maguire Mon, 12 Mar 2018 16:19:00 +0000 + +gcl (2.6.12-69) unstable; urgency=medium + + * Version_2_6_13pre58 + + -- Camm Maguire Fri, 09 Mar 2018 17:10:51 +0000 + +gcl (2.6.12-68) unstable; urgency=medium + + * Version_2_6_13pre57 + + -- Camm Maguire Sun, 04 Mar 2018 13:21:00 +0000 + +gcl (2.6.12-67) unstable; urgency=medium + + * Version_2_6_13pre55 + + -- Camm Maguire Sat, 03 Mar 2018 14:27:51 +0000 + +gcl (2.6.12-66) unstable; urgency=medium + + * Version_2_6_13pre54 + + -- Camm Maguire Fri, 02 Mar 2018 21:19:03 +0000 + +gcl (2.6.12-65) unstable; urgency=medium + + * Version_2_6_13pre52 + * Bug fix: "FTBFS on hurd-i386", thanks to svante.signell@gmail.com; + (Closes: #802593). + + -- Camm Maguire Fri, 23 Feb 2018 15:55:23 +0000 + +gcl (2.6.12-64) unstable; urgency=medium + + * list_order.24 + + -- Camm Maguire Sun, 04 Feb 2018 13:26:27 +0000 + +gcl (2.6.12-63) unstable; urgency=medium + + * list_order.23 + + -- Camm Maguire Thu, 01 Feb 2018 18:36:29 +0000 + +gcl (2.6.12-62) unstable; urgency=medium + + * list_order.22 + + -- Camm Maguire Thu, 01 Feb 2018 01:05:10 +0000 + +gcl (2.6.12-61) unstable; urgency=medium + + * list_order.21 + + -- Camm Maguire Tue, 30 Jan 2018 21:13:13 +0000 + +gcl (2.6.12-60) unstable; urgency=medium + + * list_order.19 + + -- Camm Maguire Tue, 23 Jan 2018 18:11:59 +0000 + +gcl (2.6.12-59) unstable; urgency=medium + + * list_order.16 + + -- Camm Maguire Fri, 12 Jan 2018 03:25:08 +0000 + +gcl (2.6.12-58) unstable; urgency=medium + + * list_order.14 + + -- Camm Maguire Mon, 18 Sep 2017 15:45:10 +0000 + +gcl (2.6.12-57) unstable; urgency=medium + + * list_order.13 + + -- Camm Maguire Fri, 25 Aug 2017 13:44:10 +0000 + +gcl (2.6.12-56) unstable; urgency=medium + + * list_order.12 + + -- Camm Maguire Thu, 24 Aug 2017 19:12:50 +0000 + +gcl (2.6.12-55) unstable; urgency=medium + + * disable gprof on aarch64 + * Bug fix: "gcl FTBFS on arm64: Unrecoverable error: Segmentation + violation..", thanks to Adrian Bunk (Closes: #873052). + + -- Camm Maguire Thu, 24 Aug 2017 16:37:07 +0000 + +gcl (2.6.12-54) unstable; urgency=medium + + * list_order.11 + + -- Camm Maguire Wed, 23 Aug 2017 22:19:14 +0000 + +gcl (2.6.12-53) unstable; urgency=medium + + * list_order.9 + + -- Camm Maguire Sun, 18 Jun 2017 18:32:30 +0000 + +gcl (2.6.12-52) unstable; urgency=medium + + * list_order.8 + + -- Camm Maguire Thu, 15 Jun 2017 18:04:41 +0000 + +gcl (2.6.12-51) unstable; urgency=medium + + * list_order.7 + + -- Camm Maguire Wed, 14 Jun 2017 18:30:46 +0000 + +gcl (2.6.12-50) unstable; urgency=medium + + * list_order.6 + + -- Camm Maguire Tue, 13 Jun 2017 22:38:52 +0000 + +gcl (2.6.12-49) unstable; urgency=medium + + * list_order.5 + + -- Camm Maguire Thu, 08 Jun 2017 17:21:01 +0000 + +gcl (2.6.12-48) unstable; urgency=medium + + * list_order.1 + + -- Camm Maguire Sun, 28 May 2017 01:42:29 +0000 + +gcl (2.6.12-47) unstable; urgency=high + + * pathnames1.13 + + -- Camm Maguire Tue, 22 Nov 2016 04:53:35 +0000 + +gcl (2.6.12-46) unstable; urgency=high + + * pathnames1.12 + * Bug fix: "maintainer script(s) do not start on #!", thanks to + treinen@debian.org; (Closes: #843303). + + -- Camm Maguire Fri, 18 Nov 2016 18:27:53 +0000 + +gcl (2.6.12-45) unstable; urgency=high + + * pathnames1.11 + + -- Camm Maguire Mon, 31 Oct 2016 22:57:27 +0000 + +gcl (2.6.12-44) unstable; urgency=high + + * pathnames1.9 + + -- Camm Maguire Fri, 28 Oct 2016 17:04:38 +0000 + +gcl (2.6.12-43) unstable; urgency=medium + + * pathnames1.7 + + -- Camm Maguire Thu, 27 Oct 2016 03:46:32 +0000 + +gcl (2.6.12-42) unstable; urgency=medium + + * pathnames1.6 + * Bug fix: "FTBFS with bindnow and PIE enabled", thanks to Balint Reczey + (Closes: #837481). + * Bug fix: "FTBFS with compilers that default to -fPIE (patch + attached)", thanks to Adam Conrad (Closes: #822820). + + -- Camm Maguire Wed, 26 Oct 2016 23:04:57 +0000 + +gcl (2.6.12-41) unstable; urgency=medium + + * pathnames1.4, kfreebsd fix + + -- Camm Maguire Fri, 14 Oct 2016 01:17:18 +0000 + +gcl (2.6.12-40) unstable; urgency=medium + + * pathnames1.2 + * Bug fix: "popen arguments not quoted causes trouble and security + issues", thanks to axel (Closes: #802203). + + -- Camm Maguire Wed, 12 Oct 2016 18:09:26 +0000 + +gcl (2.6.12-39) unstable; urgency=medium + + * pathnames1.1 + * ansi-test clean target + + -- Camm Maguire Wed, 12 Oct 2016 01:32:05 +0000 + +gcl (2.6.12-38) unstable; urgency=medium + + * Version_2_6_13pre50 + + -- Camm Maguire Tue, 04 Oct 2016 19:45:38 +0000 + +gcl (2.6.12-37) unstable; urgency=medium + + * Version_2_6_13pre49 + + -- Camm Maguire Mon, 03 Oct 2016 14:54:09 +0000 + +gcl (2.6.12-36) unstable; urgency=medium + + * Version_2_6_13pre48 + + -- Camm Maguire Sat, 01 Oct 2016 12:10:25 +0000 + +gcl (2.6.12-35) unstable; urgency=medium + + * Version_2_6_13pre47 + + -- Camm Maguire Fri, 30 Sep 2016 21:21:43 +0000 + +gcl (2.6.12-34) unstable; urgency=medium + + * Version_2_6_13pre45 + + -- Camm Maguire Fri, 23 Sep 2016 19:42:37 +0000 + +gcl (2.6.12-33) unstable; urgency=medium + + * Version_2_6_13pre43 + + -- Camm Maguire Tue, 03 May 2016 16:17:03 +0000 + +gcl (2.6.12-32) unstable; urgency=medium + + * Version_2_6_13pre40 + * Bug fix: "[INTL:pt_BR] Brazilian Portuguese debconf templates + translation", thanks to Adriano Rafael Gomes (Closes: #811523). + + -- Camm Maguire Wed, 20 Apr 2016 15:18:35 +0000 + +gcl (2.6.12-31) unstable; urgency=medium + + * Version_2_6_13pre39 + + -- Camm Maguire Mon, 11 Apr 2016 00:41:11 +0000 + +gcl (2.6.12-30) unstable; urgency=medium + + * Version_2_6_13pre38 + + -- Camm Maguire Wed, 06 Apr 2016 00:20:15 +0000 + +gcl (2.6.12-29) unstable; urgency=medium + + * Version_2_6_13pre35; support latest binutils + * Bug fix: "gcl ftbfs on amd64 and i386 with binutils from + experimental", thanks to Matthias Klose (Closes: #803214). + + -- Camm Maguire Thu, 29 Oct 2015 15:20:27 +0000 + +gcl (2.6.12-28) unstable; urgency=medium + + * Version_2_6_13pre35; restore hppa build + + -- Camm Maguire Tue, 27 Oct 2015 20:00:46 +0000 + +gcl (2.6.12-27) unstable; urgency=medium + + * Version_2_6_13pre34; mips64 relocs; stack saving tail-recursive equal. + + -- Camm Maguire Tue, 27 Oct 2015 16:35:06 +0000 + +gcl (2.6.12-26) unstable; urgency=medium + + * Version_2_6_13pre32 + + -- Camm Maguire Fri, 23 Oct 2015 00:03:34 +0000 + +gcl (2.6.12-25) unstable; urgency=medium + + * Version_2_6_13pre31, kfreebsd and mips64 FTBFS fix + + -- Camm Maguire Fri, 16 Oct 2015 15:03:03 +0000 + +gcl (2.6.12-24) unstable; urgency=medium + + * Version_2_6_13pre30 + + -- Camm Maguire Fri, 16 Oct 2015 02:44:23 +0000 + +gcl (2.6.12-23) unstable; urgency=medium + + * Version_2_6_13pre29 + + -- Camm Maguire Thu, 15 Oct 2015 18:09:59 +0000 + +gcl (2.6.12-22) unstable; urgency=medium + + * Version_2_6_13pre27 + + -- Camm Maguire Tue, 13 Oct 2015 14:38:53 +0000 + +gcl (2.6.12-21) unstable; urgency=medium + + * Version_2_6_13pre26 + + -- Camm Maguire Wed, 07 Oct 2015 15:14:27 +0000 + +gcl (2.6.12-20) unstable; urgency=medium + + * Version_2_6_13pre25 + + -- Camm Maguire Thu, 01 Oct 2015 15:16:14 +0000 + +gcl (2.6.12-19) unstable; urgency=medium + + * Use-dpkg-buidflags-opt-levels-in-debian-rules, -O3 has bug in 5.2.1 + * Version_2_6_13pre24 + + -- Camm Maguire Wed, 30 Sep 2015 15:45:20 +0000 + +gcl (2.6.12-18) unstable; urgency=medium + + * Version_2_6_13pre22 + + -- Camm Maguire Tue, 29 Sep 2015 16:51:03 +0000 + +gcl (2.6.12-17) unstable; urgency=medium + + * Version_2_6_13pre20 + + -- Camm Maguire Sat, 26 Sep 2015 10:34:23 -0400 + +gcl (2.6.12-16) unstable; urgency=medium + + * Version_2_6_13pre19 + + -- Camm Maguire Fri, 25 Sep 2015 18:39:52 -0400 + +gcl (2.6.12-15) unstable; urgency=medium + + * Version_2_6_13pre18 + + -- Camm Maguire Fri, 25 Sep 2015 15:08:50 +0000 + +gcl (2.6.12-14) unstable; urgency=medium + + * Version_2_6_13pre17 + + -- Camm Maguire Thu, 28 May 2015 03:37:47 +0000 + +gcl (2.6.12-13) unstable; urgency=medium + + * Version_2_6_13pre16 + + -- Camm Maguire Fri, 15 May 2015 18:09:38 +0000 + +gcl (2.6.12-12) unstable; urgency=medium + + * Version_2_6_13pre13 + + -- Camm Maguire Fri, 01 May 2015 11:08:46 -0400 + +gcl (2.6.12-11) unstable; urgency=medium + + * Version_2_6_13pre12 + + -- Camm Maguire Thu, 30 Apr 2015 12:49:16 -0400 + +gcl (2.6.12-10) unstable; urgency=medium + + * rebuild in clean sid environment + + -- Camm Maguire Mon, 27 Apr 2015 15:34:15 -0400 + +gcl (2.6.12-9) unstable; urgency=medium + + * Version_2_6_13pre8b + * Bug fix: "ftbfs with GCC-5", thanks to Matthias Klose (Closes: + #777866). + + -- Camm Maguire Mon, 27 Apr 2015 12:32:49 -0400 + +gcl (2.6.12-8) unstable; urgency=medium + + * Version_2_6_13pre7 + + -- Camm Maguire Fri, 24 Apr 2015 13:38:30 -0400 + +gcl (2.6.12-7) unstable; urgency=medium + + * Version_2_6_13pre6 + + -- Camm Maguire Thu, 23 Apr 2015 13:43:45 -0400 + +gcl (2.6.12-6) unstable; urgency=medium + + * Version_2_6_13pre5 + + -- Camm Maguire Wed, 22 Apr 2015 17:14:16 -0400 + +gcl (2.6.12-5) unstable; urgency=medium + + * Version_2_6_13pre4 + + -- Camm Maguire Wed, 22 Apr 2015 10:25:36 -0400 + +gcl (2.6.12-4) unstable; urgency=medium + + * Version_2_6_13pre3a + + -- Camm Maguire Mon, 20 Apr 2015 13:26:36 -0400 + +gcl (2.6.12-3) unstable; urgency=medium + + * Version_2_6_13pre2 + + -- Camm Maguire Fri, 17 Apr 2015 15:50:37 -0400 + +gcl (2.6.12-2) unstable; urgency=medium + + * Version_2_6_13pre1 + + -- Camm Maguire Wed, 26 Nov 2014 11:12:46 -0500 + +gcl (2.6.12-1) unstable; urgency=medium + + * New upstream release + + -- Camm Maguire Tue, 28 Oct 2014 09:56:15 -0400 + +gcl (2.6.11-6) unstable; urgency=medium + + * 2.6.12pre5 + + -- Camm Maguire Thu, 23 Oct 2014 17:33:22 -0400 + +gcl (2.6.11-5) unstable; urgency=medium + + * 2.6.12pre4 + + -- Camm Maguire Sat, 18 Oct 2014 09:46:34 -0400 + +gcl (2.6.11-4) unstable; urgency=medium + + * 2.6.12pre3 + + -- Camm Maguire Thu, 16 Oct 2014 11:56:15 -0400 + +gcl (2.6.11-3) unstable; urgency=medium + + * 2.6.12pre2 + + -- Camm Maguire Sun, 28 Sep 2014 20:56:18 -0400 + +gcl (2.6.11-2) unstable; urgency=medium + + * 2.6.12pre1 + + -- Camm Maguire Fri, 19 Sep 2014 14:49:25 -0400 + +gcl (2.6.11-1) unstable; urgency=medium + + * New upstream release + + -- Camm Maguire Sat, 06 Sep 2014 12:28:46 -0400 + +gcl (2.6.10-54) unstable; urgency=medium + + * remove-debug-message-from-BUGGY_MAXIMUM_SSCANF_LENGTH-code + + -- Camm Maguire Fri, 05 Sep 2014 10:35:46 -0400 + +gcl (2.6.10-53) unstable; urgency=medium + + * ppc64le-support-headers + + -- Camm Maguire Wed, 03 Sep 2014 15:02:12 -0400 + +gcl (2.6.10-52) unstable; urgency=medium + + * accept-TMP-paths-with-types-versions + + -- Camm Maguire Fri, 29 Aug 2014 17:51:04 -0400 + +gcl (2.6.10-51) unstable; urgency=medium + + * fix-match-function-proclaim-skew + + -- Camm Maguire Fri, 29 Aug 2014 16:40:30 +0000 + +gcl (2.6.10-50) unstable; urgency=medium + + * trial_selinux_support + + -- Camm Maguire Thu, 21 Aug 2014 17:29:50 +0000 + +gcl (2.6.10-49) unstable; urgency=medium + + * R_ARM_JUMP24 + + -- Camm Maguire Wed, 20 Aug 2014 17:08:23 +0000 + +gcl (2.6.10-48) unstable; urgency=medium + + * try-SGC-for-aarch64 + + -- Camm Maguire Tue, 19 Aug 2014 18:35:22 +0000 + +gcl (2.6.10-47) unstable; urgency=medium + + * set-stack_guard-after-alloc-setup + * Bug fix: "work around build failure on AArch64", thanks to Matthias + Klose (Closes: #758101). + + -- Camm Maguire Thu, 14 Aug 2014 19:36:48 +0000 + +gcl (2.6.10-46) unstable; urgency=medium + + * R_AARCH64_LDST128_ABS_LO12_NC + + -- Camm Maguire Wed, 13 Aug 2014 21:39:50 +0000 + +gcl (2.6.10-45) unstable; urgency=medium + + * fix sh4 CLEAR_CACHE + + -- Camm Maguire Sun, 10 Aug 2014 20:12:03 +0000 + +gcl (2.6.10-44) unstable; urgency=medium + + * clear_protect_memory on all elf machines + + -- Camm Maguire Sat, 09 Aug 2014 00:55:17 +0000 + +gcl (2.6.10-43) unstable; urgency=medium + + * mips uses builtin_clear_cache like mipsel + + -- Camm Maguire Fri, 08 Aug 2014 23:42:42 +0000 + +gcl (2.6.10-42) unstable; urgency=medium + + * backport travel_push_new from master + + -- Camm Maguire Wed, 06 Aug 2014 20:14:14 +0000 + +gcl (2.6.10-41) unstable; urgency=medium + + * protos and CFLAGS for axiom extensions + + -- Camm Maguire Wed, 06 Aug 2014 01:54:38 +0000 + +gcl (2.6.10-40) unstable; urgency=medium + + * better solaris unexec fix + + -- Camm Maguire Mon, 04 Aug 2014 22:00:54 +0000 + +gcl (2.6.10-39) unstable; urgency=medium + + * earlier prelink_init, phys_pages w/o malloc + + -- Camm Maguire Mon, 04 Aug 2014 16:52:09 +0000 + +gcl (2.6.10-38) unstable; urgency=medium + + * error on overflow of array dimensions + + -- Camm Maguire Fri, 01 Aug 2014 14:35:44 +0000 + +gcl (2.6.10-37) unstable; urgency=medium + + * FILE * casts for windows feof wrapper + + -- Camm Maguire Thu, 31 Jul 2014 02:17:11 +0000 + +gcl (2.6.10-36) unstable; urgency=medium + + * better casts for frs_jmpbuf + + -- Camm Maguire Wed, 30 Jul 2014 17:00:06 +0000 + +gcl (2.6.10-35) unstable; urgency=medium + + * find_sym_ptable typo fix + + -- Camm Maguire Tue, 29 Jul 2014 18:08:57 +0000 + +gcl (2.6.10-34) unstable; urgency=medium + + * --enable-prelink configure arg; stack_chk_guard for 68k + + -- Camm Maguire Fri, 25 Jul 2014 20:39:10 +0000 + +gcl (2.6.10-33) unstable; urgency=medium + + * hurd stack_guard, ppc64 C_GC_OFFSET + + -- Camm Maguire Thu, 24 Jul 2014 21:46:24 +0000 + +gcl (2.6.10-32) unstable; urgency=medium + + * __stack_chk_guard fix for arm/sh4 + + -- Camm Maguire Wed, 23 Jul 2014 18:12:56 +0000 + +gcl (2.6.10-31) unstable; urgency=medium + + * dpkg-buildflags trial + + -- Camm Maguire Tue, 22 Jul 2014 20:06:10 +0000 + +gcl (2.6.10-30) unstable; urgency=medium + + * fix offsets ppc + + -- Camm Maguire Tue, 22 Jul 2014 17:12:27 +0000 + +gcl (2.6.10-29) unstable; urgency=medium + + * fix unexec file offsets + + -- Camm Maguire Tue, 22 Jul 2014 15:36:45 +0000 + +gcl (2.6.10-28) unstable; urgency=high + + * enable prelink + + -- Camm Maguire Fri, 18 Jul 2014 19:24:38 +0000 + +gcl (2.6.10-27) unstable; urgency=high + + * protect closure calls from gc + + -- Camm Maguire Wed, 16 Jul 2014 16:15:33 +0000 + +gcl (2.6.10-26) unstable; urgency=high + + * Bug fix: "packages should not build-depend on binutils-dev", thanks to + Matthias Klose (Closes: #754840). Please note that gcl has long + depended on binutils-dev for good reason -- happily it is no longer + necessary + + -- Camm Maguire Tue, 15 Jul 2014 16:04:04 +0000 + +gcl (2.6.10-25) unstable; urgency=high + + * rebuild to get gcc fixes on i386 + + -- Camm Maguire Fri, 11 Jul 2014 03:14:45 +0000 + +gcl (2.6.10-24) unstable; urgency=high + + * try default gcc 4.9 + * access libopcodes without link dependency via dlopen + * Bug fix: "please switch to emacs24", thanks to Gabriele Giacone + (Closes: #754012). + + -- Camm Maguire Wed, 09 Jul 2014 17:34:21 +0000 + +gcl (2.6.10-23) unstable; urgency=high + + * rebuild latest binutils + + -- Camm Maguire Sat, 05 Jul 2014 23:19:27 +0000 + +gcl (2.6.10-22) unstable; urgency=high + + * gcc-4.8 on i386, 4.9 has bugs at present + + -- Camm Maguire Fri, 04 Jul 2014 01:36:06 +0000 + +gcl (2.6.10-21) unstable; urgency=high + + * 2.6.11pre test 20 + + -- Camm Maguire Mon, 30 Jun 2014 22:43:27 +0000 + +gcl (2.6.10-20) unstable; urgency=high + + * 2.6.11pre test 19 + + -- Camm Maguire Sun, 29 Jun 2014 17:59:59 +0000 + +gcl (2.6.10-19) unstable; urgency=high + + * 2.6.11pre test 18 + + -- Camm Maguire Sun, 29 Jun 2014 16:00:07 +0000 + +gcl (2.6.10-18) unstable; urgency=high + + * 2.6.11pre test 17 + + -- Camm Maguire Sat, 28 Jun 2014 16:57:54 +0000 + +gcl (2.6.10-17) unstable; urgency=high + + * 2.6.11pre test 16 + + -- Camm Maguire Thu, 26 Jun 2014 18:06:42 +0000 + +gcl (2.6.10-16) unstable; urgency=high + + * 2.6.11pre test 15 + + -- Camm Maguire Wed, 18 Jun 2014 17:37:36 +0000 + +gcl (2.6.10-15) unstable; urgency=high + + * 2.6.11pre test 14 + + -- Camm Maguire Tue, 17 Jun 2014 00:39:35 +0000 + +gcl (2.6.10-14) unstable; urgency=high + + * 2.6.11pre test 13 + + -- Camm Maguire Sat, 14 Jun 2014 13:43:57 +0000 + +gcl (2.6.10-13) unstable; urgency=high + + * 2.6.11pre test 12 + + -- Camm Maguire Tue, 20 May 2014 16:00:22 +0000 + +gcl (2.6.10-12) unstable; urgency=high + + * 2.6.11pre test 11 + + -- Camm Maguire Fri, 16 May 2014 17:41:33 +0000 + +gcl (2.6.10-11) unstable; urgency=high + + * 2.6.11pre test 10 + + -- Camm Maguire Fri, 16 May 2014 13:18:07 +0000 + +gcl (2.6.10-10) unstable; urgency=high + + * 2.6.11pre test 9 + + -- Camm Maguire Wed, 07 May 2014 17:10:30 +0000 + +gcl (2.6.10-9) unstable; urgency=high + + * 2.6.11pre test 8 + + -- Camm Maguire Fri, 25 Apr 2014 19:53:10 +0000 + +gcl (2.6.10-8) unstable; urgency=high + + * 2.6.11pre test 7 + + -- Camm Maguire Mon, 21 Apr 2014 14:09:37 +0000 + +gcl (2.6.10-7) unstable; urgency=high + + * 2.6.11pre test 6 + + -- Camm Maguire Sat, 19 Apr 2014 17:52:17 +0000 + +gcl (2.6.10-6) unstable; urgency=high + + * 2.6.11pre test 5 + + -- Camm Maguire Fri, 18 Apr 2014 15:06:09 +0000 + +gcl (2.6.10-5) unstable; urgency=high + + * 2.6.11pre test 4 + + -- Camm Maguire Tue, 15 Apr 2014 20:30:13 +0000 + +gcl (2.6.10-4) unstable; urgency=high + + * 2.6.11pre test 3 + * Bug fix: "debian/rules uses DEB_BUILD_* macros instead of DEB_HOST_* + macros", thanks to Matthias Klose (Closes: #743520). + + -- Camm Maguire Wed, 09 Apr 2014 13:15:32 +0000 + +gcl (2.6.10-3) unstable; urgency=high + + * 2.6.11pre test 2 + + -- Camm Maguire Thu, 03 Apr 2014 14:24:23 +0000 + +gcl (2.6.10-2) unstable; urgency=high + + * 2.6.11pre test 1 + * Bug fix: "FTBFS: gcl_readline.d:472:39: error: 'CPPFunction' + undeclared (first use in this function)", thanks to David Suárez + (Closes: #741819). + + -- Camm Maguire Mon, 24 Mar 2014 15:47:01 +0000 + +gcl (2.6.10-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Wed, 13 Nov 2013 18:39:19 +0000 + +gcl (2.6.9-17) unstable; urgency=high + + * 2.6.10pre test 17 + + -- Camm Maguire Mon, 11 Nov 2013 19:41:45 +0000 + +gcl (2.6.9-16) unstable; urgency=high + + * 2.6.10pre test 16 + * Bug fix: "gcl 2.6.7+dfsga-20 needs 1 GB disk space on amd64", thanks + to Edi Meier (Closes: #714507). + * Bug fix: "[INTL:ja] New Japanese translation", thanks to victory + (Closes: #718925). + + -- Camm Maguire Sat, 09 Nov 2013 13:34:32 +0000 + +gcl (2.6.9-15) unstable; urgency=high + + * 2.6.10pre test 15 + + -- Camm Maguire Sat, 02 Nov 2013 22:21:16 +0000 + +gcl (2.6.9-14) unstable; urgency=high + + * 2.6.10pre test 14 + + -- Camm Maguire Wed, 23 Oct 2013 17:44:14 +0000 + +gcl (2.6.9-13) unstable; urgency=high + + * environment allocation unrandomize.h + + -- Camm Maguire Mon, 21 Oct 2013 00:20:16 +0000 + +gcl (2.6.9-12) unstable; urgency=high + + * 2.6.10pre test 13 + + -- Camm Maguire Fri, 18 Oct 2013 14:18:17 +0000 + +gcl (2.6.9-11) unstable; urgency=high + + * 2.6.10pre test 12, s390, mingw cleanup, make_bignum bug fix + + -- Camm Maguire Tue, 15 Oct 2013 23:32:09 +0000 + +gcl (2.6.9-10) unstable; urgency=high + + * fast-fixnums + + -- Camm Maguire Fri, 11 Oct 2013 15:05:58 +0000 + +gcl (2.6.9-9) unstable; urgency=high + + * 2.6.10pre test 10 and 11 + + -- Camm Maguire Wed, 02 Oct 2013 19:12:36 +0000 + +gcl (2.6.9-8) unstable; urgency=high + + * 2.6.10pre test 8 and 9 + + -- Camm Maguire Tue, 01 Oct 2013 21:00:19 +0000 + +gcl (2.6.9-7) unstable; urgency=high + + * 2.6.10pre test 6 and 7 + + -- Camm Maguire Mon, 30 Sep 2013 19:34:38 +0000 + +gcl (2.6.9-6) unstable; urgency=high + + * 2.6.10pre test 5 + + -- Camm Maguire Tue, 24 Sep 2013 17:03:24 +0000 + +gcl (2.6.9-5) unstable; urgency=high + + * 2.6.10pre test 4 + + -- Camm Maguire Mon, 23 Sep 2013 19:27:36 +0000 + +gcl (2.6.9-4) unstable; urgency=high + + * 2.6.10pre test 3 + + -- Camm Maguire Mon, 23 Sep 2013 16:30:09 +0000 + +gcl (2.6.9-3) unstable; urgency=high + + * 2.6.10pre test 2 + + -- Camm Maguire Sun, 22 Sep 2013 03:27:10 +0000 + +gcl (2.6.9-2) unstable; urgency=high + + * 2.6.10pre test + + -- Camm Maguire Sat, 21 Sep 2013 04:14:55 +0000 + +gcl (2.6.9-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Wed, 28 Aug 2013 16:49:18 +0000 + +gcl (2.6.7+dfsga-40) unstable; urgency=high + + * fix allocate functions + + -- Camm Maguire Tue, 06 Aug 2013 22:36:37 +0000 + +gcl (2.6.7+dfsga-39) unstable; urgency=high + + * lower initial contiguous and relblock allocations, set *ihs-top* + properly on startup, protect memory->cfd.cfd_start initialization from + gc + + -- Camm Maguire Mon, 05 Aug 2013 17:38:22 +0000 + +gcl (2.6.7+dfsga-38) unstable; urgency=high + + * robustify near oom handling to fix axiom compile of EXPEXPAN on mips + + -- Camm Maguire Fri, 02 Aug 2013 16:25:16 +0000 + +gcl (2.6.7+dfsga-37) unstable; urgency=high + + * ppc64 gprof fix + + -- Camm Maguire Fri, 26 Jul 2013 23:40:14 +0000 + +gcl (2.6.7+dfsga-36) unstable; urgency=high + + * min_pagewidth=14 on mips + + -- Camm Maguire Fri, 26 Jul 2013 02:20:56 +0000 + +gcl (2.6.7+dfsga-35) unstable; urgency=high + + * latest gcc on all platforms, no gprof ppc64, -O1 ia64, -O0 alpha + + -- Camm Maguire Thu, 25 Jul 2013 14:42:48 +0000 + +gcl (2.6.7+dfsga-34) unstable; urgency=high + + * sgc link_array mark fix;rb_end across save fix;more stable gcc on older arches + + -- Camm Maguire Tue, 23 Jul 2013 17:11:23 +0000 + +gcl (2.6.7+dfsga-33) unstable; urgency=high + + * fix mark_link_array for marked sLAlink_arrayA->s.s_dbind + + -- Camm Maguire Mon, 22 Jul 2013 19:00:43 +0000 + +gcl (2.6.7+dfsga-32) unstable; urgency=high + + * protect mark_link_array in sgc + + -- Camm Maguire Sat, 20 Jul 2013 00:16:07 +0000 + +gcl (2.6.7+dfsga-31) unstable; urgency=high + + * properly clean link array on gc + + -- Camm Maguire Fri, 19 Jul 2013 20:34:34 +0000 + +gcl (2.6.7+dfsga-30) unstable; urgency=high + + * fix gcl.script compiler::link, darwin compile warnings + + -- Camm Maguire Mon, 15 Jul 2013 20:35:03 +0000 + +gcl (2.6.7+dfsga-29) unstable; urgency=high + + * fix compiler::link in presence of gcl.script + + -- Camm Maguire Mon, 15 Jul 2013 16:23:33 +0000 + +gcl (2.6.7+dfsga-28) unstable; urgency=high + + * install unixport/gcl.script + + -- Camm Maguire Sat, 13 Jul 2013 18:42:28 +0000 + +gcl (2.6.7+dfsga-27) unstable; urgency=high + + * workaround for ia64 and hurd brk issues + + -- Camm Maguire Fri, 12 Jul 2013 21:44:54 +0000 + +gcl (2.6.7+dfsga-26) unstable; urgency=high + + * -- command line support, map-shared in unexec + + -- Camm Maguire Fri, 12 Jul 2013 00:52:35 +0000 + +gcl (2.6.7+dfsga-25) unstable; urgency=high + + * alpha, mips, 68k + + -- Camm Maguire Wed, 10 Jul 2013 18:29:37 +0000 + +gcl (2.6.7+dfsga-24) unstable; urgency=high + + * sgc and reloc fixes + + -- Camm Maguire Mon, 08 Jul 2013 13:56:33 +0000 + +gcl (2.6.7+dfsga-23) unstable; urgency=high + + * fix for maxima on kfbsd and sparc + + -- Camm Maguire Wed, 03 Jul 2013 19:19:16 +0000 + +gcl (2.6.7+dfsga-22) unstable; urgency=high + + * fix stack definition issues on i386 + + -- Camm Maguire Tue, 02 Jul 2013 18:27:54 +0000 + +gcl (2.6.7+dfsga-21) unstable; urgency=high + + * near out of memory robustification + + -- Camm Maguire Tue, 02 Jul 2013 15:32:58 +0000 + +gcl (2.6.7+dfsga-20) unstable; urgency=high + + * fix 3GB workaround for gprof + + -- Camm Maguire Fri, 21 Jun 2013 11:09:01 -0400 + +gcl (2.6.7+dfsga-19) unstable; urgency=high + + * work around 3GB personality/alloca/malloc bug + + -- Camm Maguire Fri, 21 Jun 2013 02:46:49 +0000 + +gcl (2.6.7+dfsga-18) unstable; urgency=high + + * alpha NULL_OR_ON_C_STACK, attempt to get 32 immfix space with + ADDR_LIMIT_3GB|ADDR_COMPAT_LAYOUT personality, clean compile with no + immfix + + -- Camm Maguire Thu, 20 Jun 2013 20:24:29 +0000 + +gcl (2.6.7+dfsga-17) unstable; urgency=high + + * small optimizations, #= nil fix + + -- Camm Maguire Wed, 19 Jun 2013 16:23:27 +0000 + +gcl (2.6.7+dfsga-16) unstable; urgency=high + + * no linker script on hurd;fix OBJ_ALIGN + + -- Camm Maguire Thu, 13 Jun 2013 15:35:00 +0000 + +gcl (2.6.7+dfsga-15) unstable; urgency=high + + * ia64 fix + + -- Camm Maguire Thu, 13 Jun 2013 02:38:47 +0000 + +gcl (2.6.7+dfsga-14) unstable; urgency=high + + * eliminate maxpage/dbegin, restore windows and macosx builds + + -- Camm Maguire Wed, 12 Jun 2013 21:42:29 +0000 + +gcl (2.6.7+dfsga-13) unstable; urgency=low + + * ia64/hurd/s390 and SGC + + -- Camm Maguire Sun, 09 Jun 2013 00:23:51 +0000 + +gcl (2.6.7+dfsga-12) unstable; urgency=low + + * ia64/hurd/s390 + + -- Camm Maguire Sat, 08 Jun 2013 15:24:46 +0000 + +gcl (2.6.7+dfsga-11) unstable; urgency=high + + * 2.6.9 test + + -- Camm Maguire Fri, 07 Jun 2013 21:46:41 +0000 + +gcl (2.6.7+dfsga-10) unstable; urgency=high + + * output mips make bug text to stderr + + -- Camm Maguire Sat, 25 May 2013 12:24:35 +0000 + +gcl (2.6.7+dfsga-9) unstable; urgency=high + + * mips make bug workaround + + -- Camm Maguire Wed, 22 May 2013 14:23:43 +0000 + +gcl (2.6.7+dfsga-8) unstable; urgency=high + + * revert doubled default maxpage + * export *read-eval* + + -- Camm Maguire Tue, 21 May 2013 14:42:05 +0000 + +gcl (2.6.7+dfsga-7) unstable; urgency=high + + * export ansi symbols + + -- Camm Maguire Sat, 11 May 2013 21:36:56 +0000 + +gcl (2.6.7+dfsga-6) unstable; urgency=high + + * fast hash-equal in compiler + + -- Camm Maguire Sat, 11 May 2013 19:11:42 +0000 + +gcl (2.6.7+dfsga-5) unstable; urgency=high + + * Bug fix: "FTBFS: cp: cannot stat + 'debian/tmp/usr/share/info/gcl-si.info': No such file or + directory", thanks to Lucas Nussbaum (Closes: #707490). + + -- Camm Maguire Fri, 10 May 2013 18:09:14 +0000 + +gcl (2.6.7+dfsga-4) unstable; urgency=high + + * sgc-on fix with latest gcc + + -- Camm Maguire Tue, 23 Apr 2013 18:45:11 +0000 + +gcl (2.6.7+dfsga-3) unstable; urgency=high + + * hash depth bug fix + * new s390 reloc + + -- Camm Maguire Thu, 24 Jan 2013 19:46:30 +0000 + +gcl (2.6.7+dfsga-2) unstable; urgency=high + + * more arm relocs supported;check default timezone dynamically;follow + bash ~ semantics in user-homedir-pathname + + -- Camm Maguire Mon, 21 Jan 2013 18:41:06 +0000 + +gcl (2.6.7+dfsga-1) unstable; urgency=high + + * Acknowledge Non-maintainer upload. + (thanks David Prévot ) + * Remove unused and non DFSG-compliant gmp3/gmp.* from source. + (Closes: #695721) + * Show translated debconf templates, thanks to Denis Barbier for the + analysis and the proposed fixes. (Closes: #691946) + * trim excess digits from printed floats + + -- Camm Maguire Tue, 15 Jan 2013 20:46:25 +0000 + +gcl (2.6.7-108) unstable; urgency=high + + * Depend on emacs23 | emacsen to allow wheezy propagation + + -- Camm Maguire Mon, 08 Oct 2012 18:08:36 +0000 + +gcl (2.6.7-107) unstable; urgency=high + + * mode 644 on ucf newfile + + -- Camm Maguire Wed, 03 Oct 2012 20:38:43 +0000 + +gcl (2.6.7-106) unstable; urgency=high + + * Bug fix: "modifies conffiles (policy 10.7.3): /etc/default/gcl", + thanks to Andreas Beckmann (Closes: #688201). + + -- Camm Maguire Wed, 03 Oct 2012 16:52:10 +0000 + +gcl (2.6.7-105) unstable; urgency=high + + * restore #DEBHELPER# to postinst and postrm scripts + + -- Camm Maguire Mon, 01 Oct 2012 17:31:43 +0000 + +gcl (2.6.7-104) unstable; urgency=high + + * Bug fix: "modifies conffiles (policy 10.7.3): /etc/default/gcl", + thanks to Andreas Beckmann (Closes: #688201). + + -- Camm Maguire Mon, 01 Oct 2012 15:32:52 +0000 + +gcl (2.6.7-103) unstable; urgency=high + + * sfaslelf.c: FIX_HIDDEN_SYMBOLS + + -- Camm Maguire Wed, 22 Aug 2012 15:13:12 +0000 + +gcl (2.6.7-102) unstable; urgency=high + + * Fix hash key distribution bug, bitvector equal bug + * distinguish car position in equal-hash of lists + + -- Camm Maguire Mon, 20 Aug 2012 17:33:26 +0000 + +gcl (2.6.7-101) unstable; urgency=high + + * add alpha, ppc, ppc64, and ia64 to __builtin__clear_cache exception + list as per gcc maintainers + * lintian cleanups + + -- Camm Maguire Sat, 05 May 2012 23:18:56 +0000 + +gcl (2.6.7-100) unstable; urgency=high + + * nil case keylist support + * Bug fix: "[INTL:da] Danish translation of the debconf templates gcl", + thanks to Joe Dalton (Closes: #666528). + + -- Camm Maguire Fri, 20 Apr 2012 02:25:26 +0000 + +gcl (2.6.7-99) unstable; urgency=low + + * case default error checking + + -- Camm Maguire Fri, 23 Mar 2012 14:14:44 +0000 + +gcl (2.6.7-98) unstable; urgency=low + + * restore traditional make-sequence,make-array, and coerce, and + optimize replace, as 2.6.8 compiler is still too weak re: inlines + + -- Camm Maguire Fri, 20 Jan 2012 19:55:45 +0000 + +gcl (2.6.7-97) unstable; urgency=low + + * evade __builtin___clear_cache on hppa + * make-array;make-sequence;replace;coerce + + -- Camm Maguire Fri, 20 Jan 2012 05:13:22 +0000 + +gcl (2.6.7-96) unstable; urgency=low + + * better XDR detection; no __builtin_clear_cache on sh4 + + -- Camm Maguire Wed, 18 Jan 2012 01:32:43 +0000 + +gcl (2.6.7-95) unstable; urgency=low + + * clear_cache after mprotect + + -- Camm Maguire Tue, 17 Jan 2012 03:54:56 +0000 + +gcl (2.6.7-94) unstable; urgency=low + + * optimize unwind at O0 to workaround gcc bug; centralize on + __builtin__clear_cache when available;arm_thm_call reloc support + + -- Camm Maguire Mon, 16 Jan 2012 20:10:07 +0000 + +gcl (2.6.7-93) unstable; urgency=low + + * remove C_GC_OFFSET for sparc64 + * remove ncurses dependency for readline + * Bug fix: "FTBFS: dpkg-buildpackage: error: dpkg-source -b gcl-2.6.7 + gave error exit status 2", thanks to Didier Raboud (Closes: #643131). + * Bug fix: "drops readline support if rebuilt", thanks to Sven Joachim + (Closes: #646735). + * lower opts on sparc64 asof gcc 4.6.1 + + -- Camm Maguire Wed, 11 Jan 2012 21:04:23 +0000 + +gcl (2.6.7-92) unstable; urgency=low + + * remove gprof on arm as mcount calls are 24/22bit -- marginally + accessible + + -- Camm Maguire Sat, 07 Jan 2012 02:42:06 +0000 + +gcl (2.6.7-91) unstable; urgency=low + + * s390x reloc support + * lower C optimization on ia64, arm and mips for now + + -- Camm Maguire Thu, 05 Jan 2012 17:30:01 +0000 + +gcl (2.6.7-90) unstable; urgency=low + + * libtirpc check for newest glibc + * read_preserving_whitespace fix + * armhf reloc support + * s390x support + * try C_GC_OFFSET for sparc64 + + -- Camm Maguire Wed, 04 Jan 2012 19:51:13 +0000 + +gcl (2.6.7-89) unstable; urgency=low + + * support new mips relocs + * lower opt to work around gcc 4.6 bug on arm + + -- Camm Maguire Wed, 11 May 2011 20:06:04 +0000 + +gcl (2.6.7-88) unstable; urgency=low + + * Bug fix: "FTBFS: gcl_arraylib.c:4:42: error: 'VV' undeclared + (first use in this function)", thanks to Lucas Nussbaum (Closes: + #625032). + + -- Camm Maguire Mon, 09 May 2011 16:00:21 +0000 + +gcl (2.6.7-87) unstable; urgency=low + + * mips reloc fix;configure default dlopen fix;clean rules and makefiles + + -- Camm Maguire Fri, 05 Nov 2010 13:29:05 +0000 + +gcl (2.6.7-86) unstable; urgency=low + + * remove binutils subdir, configure and make changes + + -- Camm Maguire Thu, 04 Nov 2010 17:55:48 +0000 + +gcl (2.6.7-85) unstable; urgency=low + + * fix mips relocs for non-static clines + + -- Camm Maguire Tue, 02 Nov 2010 13:56:40 +0000 + +gcl (2.6.7-84) unstable; urgency=low + + * better mips relocs, fix link on mingw32 + + -- Camm Maguire Sat, 30 Oct 2010 00:07:39 +0000 + +gcl (2.6.7-83) unstable; urgency=low + + * fix alpha stubs; fix sparc64 typo; print armhf relocs + + -- Camm Maguire Thu, 28 Oct 2010 13:43:16 +0000 + +gcl (2.6.7-82) unstable; urgency=low + + * mips64 fixes + + -- Camm Maguire Tue, 26 Oct 2010 18:20:04 +0000 + +gcl (2.6.7-81) unstable; urgency=low + + * sparc64;mips64 + + -- Camm Maguire Tue, 26 Oct 2010 03:33:52 +0000 + +gcl (2.6.7-80) unstable; urgency=low + + * alpha stubs; sgc mips kernel bug test; mips GPREL32 reloc + + -- Camm Maguire Mon, 25 Oct 2010 19:52:51 +0000 + +gcl (2.6.7-79) unstable; urgency=low + + * mips ld_bind_now, disable sgc workaround mips SIGBUS bug + + -- Camm Maguire Wed, 20 Oct 2010 15:31:59 +0000 + +gcl (2.6.7-78) unstable; urgency=low + + * mips local got relocs + + -- Camm Maguire Tue, 12 Oct 2010 17:15:35 +0000 + +gcl (2.6.7-77) unstable; urgency=low + + * workaround gcc alpha bug + * fix alpha reloc + + -- Camm Maguire Fri, 01 Oct 2010 21:25:11 +0000 + +gcl (2.6.7-76) unstable; urgency=low + + * fix page_multiple usage for runtime pagesize variance and stable mipsel builds + * sparc64 support + + -- Camm Maguire Fri, 01 Oct 2010 19:18:47 +0000 + +gcl (2.6.7-75) unstable; urgency=low + + * fix alpha bug + + -- Camm Maguire Tue, 28 Sep 2010 20:23:21 +0000 + +gcl (2.6.7-74) unstable; urgency=low + + * fix alpha relocs for axiom + + -- Camm Maguire Tue, 28 Sep 2010 16:07:38 +0000 + +gcl (2.6.7-73) unstable; urgency=low + + * sparc reloc updates + * fast-link fix + + -- Camm Maguire Fri, 24 Sep 2010 19:23:16 +0000 + +gcl (2.6.7-72) unstable; urgency=low + + * remove unused symbols from gcl_cmpopt.lsp + * reloc updates + * clear gcc warning + * default tilde expansion to HOME env in absence of passwd + * configure typo fix + + -- Camm Maguire Wed, 22 Sep 2010 19:32:52 +0000 + +gcl (2.6.7-71) unstable; urgency=low + + * print sparc64 relocs + + -- Camm Maguire Sat, 28 Aug 2010 14:50:00 +0000 + +gcl (2.6.7-70) unstable; urgency=low + + * sparc64/m68k + + -- Camm Maguire Fri, 27 Aug 2010 16:54:11 +0000 + +gcl (2.6.7-69) unstable; urgency=low + + * Bug fix: "non-standard gcc/g++ used for build (gcc-4.3)", thanks to + Matthias Klose (Closes: #594280). + + -- Camm Maguire Thu, 26 Aug 2010 19:08:39 +0000 + +gcl (2.6.7-68) unstable; urgency=low + + * ppc/mips elf reloc fixes + + -- Camm Maguire Mon, 23 Aug 2010 20:54:30 +0000 + +gcl (2.6.7-67) unstable; urgency=low + + * Fix compiler::link ansi combo + + -- Camm Maguire Sat, 21 Aug 2010 02:05:37 +0000 + +gcl (2.6.7-66) unstable; urgency=low + + * ppc autobuild fix + * Bug fix: "FTBFS: sfasli.c:139: error: invalid initializer", thanks to + Lucas Nussbaum (Closes: #593037). + * Bug fix: "FTBFS on powerpc: Error: The function TK::GET-AUTOLOADS is + undefined.", thanks to Mehdi Dogguy (Closes: #593191). + + -- Camm Maguire Fri, 20 Aug 2010 01:25:09 +0000 + +gcl (2.6.7-65) unstable; urgency=low + + * autobuilder fixes + + -- Camm Maguire Sat, 14 Aug 2010 11:30:46 +0000 + +gcl (2.6.7-64) unstable; urgency=low + + * configure fix + + -- Camm Maguire Fri, 13 Aug 2010 23:26:07 +0000 + +gcl (2.6.7-63) unstable; urgency=low + + * macosx support, ppc, i386 and x86_64 -- sfaslmacho.c + * windows/wine support -- sfaslcoff.c + * better custreloc support obviating my_plt -- sfaslelf.c + * debian default custreloc build where supported, all but ia64 and hppa + * fix mingw/wine path issues + + -- Camm Maguire Fri, 13 Aug 2010 16:08:49 +0000 + +gcl (2.6.7-62) unstable; urgency=high + + * more stable sgc detection via h/tsgc.h + * fix plt.h bug on hppa + * sublis1-inline fix for acl2 + + -- Camm Maguire Mon, 26 Jul 2010 16:03:54 +0000 + +gcl (2.6.7-61) unstable; urgency=high + + * mac osx support + * fix undef sgc bug in cmpinclude.h + + -- Camm Maguire Tue, 20 Jul 2010 14:50:19 +0000 + +gcl (2.6.7-60) unstable; urgency=high + + * fix sh4 support + + -- Camm Maguire Thu, 29 Apr 2010 18:09:04 +0000 + +gcl (2.6.7-59) unstable; urgency=high + + * fix hurd support + + -- Camm Maguire Fri, 23 Apr 2010 17:12:54 +0000 + +gcl (2.6.7-58) unstable; urgency=high + + * hurd support + * sh4 support + + -- Camm Maguire Fri, 23 Apr 2010 05:09:29 +0000 + +gcl (2.6.7-57) unstable; urgency=high + + * static function pointer wrapper for gcl_gmp_allocfun, stabilizing gmp + on hppa/ia64 + + -- Camm Maguire Mon, 12 Apr 2010 22:28:41 +0000 + +gcl (2.6.7-56) unstable; urgency=high + + * __builtin___clear_cache on arm + * gcc-4.3 on alpha + + -- Camm Maguire Thu, 28 Jan 2010 00:32:16 +0000 + +gcl (2.6.7-55) unstable; urgency=low + + * SGC fix, debian override fix, xgcl update + * SGC fix for relocatable and contiguous gmp storage + * configure fix for arm and hppa + + -- Camm Maguire Tue, 26 Jan 2010 19:43:08 +0000 + +gcl (2.6.7-54) unstable; urgency=low + + * robustify user_match, unrandomize, read-char-no-hang for sockets + * SA_SIGINFO for 386-linux + * if cmpinclude.h is not available, use *cmpinclude-string* in compiler-pass2 + + -- Camm Maguire Wed, 20 Jan 2010 19:02:28 +0000 + +gcl (2.6.7-53) unstable; urgency=low + + * revert round ratio to nearest + + -- Camm Maguire Tue, 05 Jan 2010 03:06:59 +0000 + +gcl (2.6.7-52) unstable; urgency=low + + * SIGINFO for kfreebsd-386 + + -- Camm Maguire Mon, 04 Jan 2010 17:49:05 +0000 + +gcl (2.6.7-51) unstable; urgency=low + + * user_match exscapes once only + + -- Camm Maguire Sun, 03 Jan 2010 05:31:20 +0000 + +gcl (2.6.7-50) unstable; urgency=low + + * gcc 4.4 warning cleanups + + -- Camm Maguire Thu, 31 Dec 2009 20:43:39 +0000 + +gcl (2.6.7-49) unstable; urgency=low + + * Bug fix: "/bin/sh: line 6: /bin/gcl: Permission denied", thanks to + Nobuhiro Iwamatsu (Closes: #561554). + + -- Camm Maguire Wed, 30 Dec 2009 23:04:39 +0000 + +gcl (2.6.7-48) unstable; urgency=low + + * round to nearest in ratio to double + + -- Camm Maguire Wed, 16 Dec 2009 15:01:55 +0000 + +gcl (2.6.7-47) unstable; urgency=low + + * Bug fix: "configure: error: Need zlib for bfd linking", thanks to + Cyril Brulebois (Closes: #560761). + * Bug fix: "Disfunctional maintainer address", thanks to Joerg Jaspert + (Closes: #560752). + + -- Camm Maguire Mon, 14 Dec 2009 19:06:45 +0000 + +gcl (2.6.7-46) unstable; urgency=low + + * support newer binutils with output_bfd element + * Fix 64bit interrupt bug + * reader error fix + * Ensure plt entries are not blank + * plt table reading fix + * Bug fix: "FTBFS: current binutils static libs need -lz", thanks to + Daniel Schepler (Closes: #521929). + * Bug fix: "replacing libreadline5-dev build dependency with + libreadline-dev", thanks to Matthias Klose (Closes: #553761). + * Bug fix: "crash after ctrl-C", thanks to Miroslaw Kwasniak (Closes: + #519903). + * Bug fix: "FTBFS with binutils-gold", thanks to Peter Fritzsche + (Closes: #554418). -ldl added to bfd linker args + * Bug fix: "[INTL:es] Spanish debconf template translation for gcl", + thanks to Francisco Javier Cuadrado (Closes: #508728). + * Bug fix: "[INTL:it] Italian translation", thanks to Vincenzo + Campanella (Closes: #560364). + * gcc error/warning cleanups + * fix plt table awk + + -- Camm Maguire Fri, 11 Dec 2009 17:45:14 +0000 + +gcl (2.6.7-45) unstable; urgency=high + + * proper word order detection macro, fixes armel + + -- Camm Maguire Mon, 01 Sep 2008 13:48:16 +0000 + +gcl (2.6.7-44) unstable; urgency=high + + * backoff on arm opts + * more careful handling of GCL_GPROF_START + + -- Camm Maguire Sat, 23 Aug 2008 21:28:52 +0000 + +gcl (2.6.7-43) unstable; urgency=low + + * redo unrandomize.h to enable compilation under -O2 -- FIXME; Closes: 494153 + + -- Camm Maguire Wed, 20 Aug 2008 21:18:43 +0000 + +gcl (2.6.7-42) unstable; urgency=low + + * more div/rem symbols for alpha + + -- Camm Maguire Sun, 03 Aug 2008 11:18:51 +0000 + +gcl (2.6.7-41) unstable; urgency=low + + * more div/rem symbols for arm and hppa + + -- Camm Maguire Sat, 02 Aug 2008 00:36:07 +0000 + +gcl (2.6.7-40) unstable; urgency=low + + * default gcc with pic enabled on mips/mipsel + + -- Camm Maguire Fri, 01 Aug 2008 13:28:00 -0400 + +gcl (2.6.7-39) unstable; urgency=high + + * gcc 4.2 for mips/mipsel for now + * __divdi3 et. al. symbols for ia64 and arm + * clean some compiler warnings + + -- Camm Maguire Fri, 01 Aug 2008 12:53:07 -0400 + +gcl (2.6.7-38) unstable; urgency=low + + * No infinite unrandomization loops + + -- Camm Maguire Thu, 31 Jul 2008 15:18:37 -0400 + +gcl (2.6.7-37) unstable; urgency=low + + * Non-maintainer upload to fix pending l10n issues + * Debconf templates and debian/control reviewed by the debian-l10n- + english team as part of the Smith review project. Closes: #457025 + * [Debconf translation updates] + - Portuguese. Closes: #457576 + - Czech. Closes: #457677 + - French. Closes: #458120 + - Finnish. Closes: #458255 + - Galician. Closes: #458529 + - Vietnamese. Closes: #459008 + - Russian. Closes: #459308 + - Dutch. Closes: #459541 + - German. Closes: #459887 + * [Lintian] Correct FSF address in debian/copyright + * [Lintian] Remove extra whitespaces at the end of + debian/in.gcl-doc.doc-base.tk + * [Lintian] Correct section in doc-base documents from Apps/Programming + to Programming + * Accept NMU + * Bug fix: "[INTL:sv] po-debconf file for gcl", thanks to Martin Ågren + (Closes: #492241). + * Bug fix: "gcl: FTBFS [amd64]: cannot trap sbrk", thanks to Daniel + Schepler (Closes: #487435). Modified and applied personality handling + patch. + * Bug fix: "gcl: Builds broken package with gcc-4.3", thanks to Daniel + Schepler (Closes: #467474). Added sincos to plttest.c + + -- Camm Maguire Thu, 31 Jul 2008 15:18:15 -0400 + +gcl (2.6.7-36) unstable; urgency=low + + * statsysbfd in Debian, incoporating modules into libgcl.a for + compiler::link support + + -- Camm Maguire Fri, 30 Nov 2007 12:03:31 -0500 + +gcl (2.6.7-35) unstable; urgency=low + + * drop gcc-3.4 on arm, Closes: #440421 + * Depend on emacs22 | emacsen, Closes: #440190 + * debconf translations Closes: #410683, Closes: #419736, Closes: #423706, Closes: #441408 + + -- Camm Maguire Fri, 23 Nov 2007 10:25:23 -0500 + +gcl (2.6.7-34) unstable; urgency=low + + * add read-byte,read-sequence,write-byte,write-sequence support + * fix some float parsing inaccuracies + * support GNU_HASH sections, Closes: #426135 + * safety 2 for certain low level functions in gcl_listlib.lsp, CLoses: + #415266 + + -- Camm Maguire Wed, 4 Jul 2007 16:23:25 -0400 + +gcl (2.6.7-33) unstable; urgency=low + + * Fix leading underscore behavior of my_plt + * add sqrt to plttest.c + * disable-nls added to the binutils subconfigures to avoid msgfmt + dependency + * remove -lintl from powerpc-macosx.defs + * update to make-user-init from cvs head to support hol88, fix link on + mingw + * solaris-i386 support + * fix read-char-no-hang on mingw + * fast compile without wrap-literals + * sigaltstack support + * fix cerror + + -- Camm Maguire Wed, 16 May 2007 12:45:40 -0400 + +gcl (2.6.7-32) unstable; urgency=low + + * static function pointers for hppa + + -- Camm Maguire Sun, 29 Oct 2006 02:15:13 -0500 + +gcl (2.6.7-31) unstable; urgency=low + + * no C optimization on hppa, gcc 4.x on hppa + * update cs.po, Closes: #389211 + + -- Camm Maguire Fri, 27 Oct 2006 13:06:55 -0400 + +gcl (2.6.7-30) unstable; urgency=low + + * make sure *tmp-dir* is set + * makeinfo is optional + + -- Camm Maguire Wed, 25 Oct 2006 17:37:54 -0400 + +gcl (2.6.7-29) unstable; urgency=low + + * Fix build issues on hppa and m68k + + -- Camm Maguire Sat, 21 Oct 2006 15:10:41 -0400 + +gcl (2.6.7-28) unstable; urgency=low + + * si::gettimeofday function for HOL88 build;macosx fixes + + -- Camm Maguire Wed, 18 Oct 2006 13:21:26 -0400 + +gcl (2.6.7-27) unstable; urgency=low + + * unrestricted gcc for alpha + * more default stack space + + -- Camm Maguire Tue, 17 Oct 2006 16:33:43 -0400 + +gcl (2.6.7-26) unstable; urgency=low + + * Fix large float read bug in c1constant-value + + -- Camm Maguire Mon, 16 Oct 2006 12:41:03 -0400 + +gcl (2.6.7-25) unstable; urgency=low + + * build-dep on gcc3.4 where appropriate + * Newer standards + + -- Camm Maguire Thu, 12 Oct 2006 09:37:08 -0400 + +gcl (2.6.7-24) unstable; urgency=low + + * build-dep on gcc3.4 where appropriate + * Newer standards + + -- Camm Maguire Thu, 12 Oct 2006 02:22:04 -0400 + +gcl (2.6.7-23) unstable; urgency=low + + * backoff to gcc-3.4 on alpha,arm,hppa, and m68k + + -- Camm Maguire Wed, 11 Oct 2006 10:16:59 -0400 + +gcl (2.6.7-22) unstable; urgency=low + + * HAVE_SYS_SOCKIO_H for solaris + * autolocbfd for solaris + * no -Wall when no gcc + * no -fomit-frame-pointer on m68k + * no profiling on mips + * $(AWK) instead of awk + * si::stat function + * fix 'the boolean type coersion error + * no varargs on cygwin + * while eval macro + * gensym counter fixes + * xgcl updates + + + -- Camm Maguire Fri, 15 Sep 2006 13:48:28 -0400 + +gcl (2.6.7-21) unstable; urgency=low + + * Fix socket write error + + -- Camm Maguire Wed, 6 Sep 2006 09:59:50 -0400 + +gcl (2.6.7-20) unstable; urgency=low + + * fix ia64 build + + -- Camm Maguire Thu, 31 Aug 2006 15:14:18 -0400 + +gcl (2.6.7-19) unstable; urgency=low + + * xgcl upgrade + * parse_number from cvs head with *read-base* fixes + * fix object_to_string + * install xgcl-2/sysdef.lisp + * fix info dir and emacs site lisp dir installation + * New xgcl readme + * Remove bashism from debian/rules, Closes: #376806, Closes: #385176. + * Fix dwdoc doc-base error, Closes: #385126 + + -- Camm Maguire Wed, 30 Aug 2006 12:13:46 -0400 + +gcl (2.6.7-18) unstable; urgency=low + + * remove emacs build dependency + * synch xgcl-2 with Novak edits + * fix build errors + * Remove power of two limit to MAXPAGE;fix X lib paths + * configure cleanup + * delete-file works on directories;build xgcl the old way;latest xgcl + from Gordon Novak + + -- Camm Maguire Wed, 23 Aug 2006 14:19:51 -0400 + +gcl (2.6.7-17) unstable; urgency=low + + * Bug fix: "gcl: [INTL:sv] Swedish debconf templates translation", + thanks to Daniel Nylander (Closes: #343695). + * Bug fix: "gcl: French debconf templates translation update", thanks to + Sylvain Archenault (Closes: #344629). + * clean xgcl-2/gmon.out + * cleanup latest gcc type-punning warnings + * defentry C proclamations and xgcl cleanup + + -- Camm Maguire Mon, 26 Jun 2006 16:45:09 +0000 + +gcl (2.6.7-16) unstable; urgency=high + + * Add missing build dependencies, omit html generation to avoid non-free + dependencies, CLoses: #372574. + + -- Camm Maguire Mon, 19 Jun 2006 14:05:59 +0000 + +gcl (2.6.7-15) unstable; urgency=low + + * Use internal gettext for bfd + * Restore xgcl2 + * Set compiler::*tmp-dir* at runtime + * report tmp-dir setting with system-banner to enable clean -eval - + batch operation; fix listen on socket streams; use (abs (getpid)) in + tmp names for Windows + * fix configure unbalanced quotes + * support for bignums in nth et.al. + * Fix branch cut of atanh + * Fix typep on simple-arrays + * prevent nested free errors + * revert atanh branch cut change + * Fix function documentation wrapping by compile + * cond evalmacro from cvs head + * Fix fixnum declarations in new smallnthcdr/bignthcdr + * fix simple-array typep + * updates for lsp/sys-proclaim + * xgcl integration + + -- Camm Maguire Fri, 9 Jun 2006 17:52:22 +0000 + +gcl (2.6.7-14) unstable; urgency=low + + * Add mount declaration to plt.c + + -- Camm Maguire Sun, 18 Dec 2005 12:56:51 +0000 + +gcl (2.6.7-13) unstable; urgency=low + + * Add feof to plttest.c for macosx + * plt related fixes for macosx + * fix configure + * Cleanup LEADING_UNDERSCORE case in plt.c et.al for macosx et.al. + * pass devices if present in compiler::get-temp-dir, fix disassemble + for new gazonk name pattern + + -- Camm Maguire Sat, 17 Dec 2005 15:22:40 +0000 + +gcl (2.6.7-12) unstable; urgency=low + + * Fix read-char-no-hang + * Strip emacs warnings when finding site-lisp directory + * mach-o update for latest binutils + * Latext bfd mach-o support from Aurelien + * revert to locbfd default on ppc-macosx + * More ppc macosx fixes from Aurelien + * revert a few macosx changes + * default to void * prototype on my_sbrk for latest macosx pending + Aureliens #ifdef + * Fix plt.h parsing on macosx + * Fix leading_underscore detection on mac + * macosx name mangling fixes + * multi-process safe gazonk names in compiler::*tmp-dir* + * Add underscore-mangled setjmp calls to plttest.c for macosx + * Fix POTFILES.in, Closes: #336207. + * Update templates, Closes: #324636 + * New French and Swedish translations, Closes: #333654, Closes: #336757. + + -- Camm Maguire Wed, 14 Dec 2005 18:52:49 +0000 + +gcl (2.6.7-11) unstable; urgency=low + + * Remove gcc-3.3 for arm in debian/rules + * make default maxpage depend on SIZEOF_LONG and PAGEWIDTH in a sane + fashion + + -- Camm Maguire Thu, 20 Oct 2005 00:08:37 +0000 + +gcl (2.6.7-10) unstable; urgency=low + + * Fix long-call gcc configure bug for ppc, add fdollars in + identifiers on arm + * remove gcc restrictions on arm + * revert 64bit coersion (gmp_big.c, maybe_replace_big) and replace with + code in siLnani (main.c) to get addresses from bignums. 2.7.0 will + have 64bit fixnums on 64bit machines, but this should not be + backported to 2.6.x + + -- Camm Maguire Wed, 12 Oct 2005 23:11:12 +0000 + +gcl (2.6.7-9) unstable; urgency=low + + * 64bit fixnum fasd data format fix from cvs head + + -- Camm Maguire Wed, 5 Oct 2005 18:49:50 +0000 + +gcl (2.6.7-8) unstable; urgency=low + + * Fix 64bit fixnum coersion bug using code from cvs HEAD + + -- Camm Maguire Fri, 30 Sep 2005 22:14:38 +0000 + +gcl (2.6.7-7) unstable; urgency=high + + * Scan .o file for init name when using dlopen + * Set init name using .o file instead of source file by default + * wrap-literals function from cvs head to allow optimizations using + compile or compile-file + * ADDR_NO_RANDOMIZE fix + + -- Camm Maguire Thu, 29 Sep 2005 17:50:56 +0000 + +gcl (2.6.7-6) unstable; urgency=high + + * Build bfd snapshot locally, Closes: #318681 + + -- Camm Maguire Tue, 20 Sep 2005 17:53:17 +0000 + +gcl (2.6.7-5) unstable; urgency=high + + * gcc-3.3 for arm + + -- Camm Maguire Thu, 15 Sep 2005 20:33:00 +0000 + +gcl (2.6.7-4) unstable; urgency=high + + * gcc 3.4 on arm to work around reserved '$' identifiers. + * gcl: French translation update + * French translation added, Closes: #325214 + * Czech translation added, Closes: #325869 + + -- Camm Maguire Thu, 15 Sep 2005 13:45:11 +0000 + +gcl (2.6.7-3) unstable; urgency=low + + * static wraper for compiled_regexp for ia64 + + -- Camm Maguire Sat, 10 Sep 2005 11:26:37 +0000 + +gcl (2.6.7-2) unstable; urgency=high + + * rebuild against libgmp3c2, Closes: #323765 + * 2.6.7 fixes all gcc 4.0 issues. Closes: #323979 + + -- Camm Maguire Wed, 24 Aug 2005 00:44:48 +0000 + +gcl (2.6.7-1) unstable; urgency=high + + * Fix (listen) with readline on + * fix control-d with readline + * libreadline5 support for Debian + * Support for pre-compiled regexps and new texinfo format + * Reenable run-process + * Push function 'accept into lisp, use select for 'listen on socket + streams + * New Upstream release version + * Native-reloc feature + * Add daemon capabilities to server sockets, document socket and + accept + * Some gcl-tk fixes + * Update wrapt-literals strategy to be consistent with CVS head -- + wrap evreything but symbols and integers, don't wrap when keeping + the gazonk files for linking in different images, this is really a + compile-file operation + * gcltk demo cleanups + * Probe-file, open_stream, and the like fail on directories + * Resolve symlinks in truename + * Place prototypes for defcfun in header files + * Support for unique init names for compiler::link and the like + * libreadline5 for Debian + * remove _o from init-names + * gcc-4.0 fixups + * Bug fix: "gcl: depends on binutils-dev <<= 2.1.5-999), so + uninstallable in unstable", thanks to Steve Langasek (Closes: + #318681). Rebuild with new release to autocompute this dep + * Bug fix: "gcl: Please switch to po-debconf", thanks to Lucas Wall + (Closes: #295930). Apply po-debconf patch + * Newer standards + + -- Camm Maguire Thu, 11 Aug 2005 15:00:26 +0000 + +gcl (2.6.6-1) unstable; urgency=high + + * New upstream release + * Allow .data section to be first in executable, as on solaris. Also + allow for new bfd section size semantics + * Don't try to write map file when not using GNU ld. Also allow + compile-file to process pathnames with whitespace on Windows + * Fix corner case fixnum arithmetic on 64bit machines + * Rework gmp_wrappers semantics for older gcc + * Explicitly mprotect loaded code pages PROT_EXEC on x86 Linux, as FC3 + now requires it. + * lisp-implementation-version is GCL + * Reader extension patch allowing for foo::(bar foobar) semantics + * a shell script variable fix in "unixport/makefile" for MSYS + * __MINGW32__ malloc initialisation fix in "o/alloc.c" + * Windows file/directory fixes in "o/unixfsys.c" + * MinGW32 -march in configure - removes deprecation warnings + * MinGW32 directory fix - "o/mingfile.c". + * Allow for sysconf to determine clock granularity at compile time to + fix time errors on the Itanium + * Disable SGC on macosx until the sgc/save problem can be fixed. + * Fix fixnum print bug on 64bit + * Fix nil types in room report + * 64bit fixes to fixnum_add and fixnum_sub + * Fix Mac SGC/save bug, at least in part + + -- Camm Maguire Sun, 16 Jan 2005 02:28:50 +0000 + +gcl (2.6.5-1) unstable; urgency=high + + * New gmp_wrappers.{c,h} files that prevent all GBC within gmp, + obviating the need for gmp patches and a local gmp configure. FIXME + -- extend to all gmp functions in a systematic way, and write header + information for future use in the compiler, making sure that plt.c + carries the needed gmp symbols at this point + * Build support for gmp_wrappers + * Support for gmp_wrappers in alloc_relblock/alloc_contblock;Support + for GCL_GPROF_START define in gprof functions + * dynsysgmp on by default; configure backs off to local gmp configure + and build automatically if needed either because gmp not present or + patched symbols are needed; autodetect and set the _start symbol + when using gprof + * Fix (setf (get ...) ...) return bug when interpreted + * Fix overwrite end of sgc_type_map bug + * Versioned depends on binutils-dev manually installed by Debian build + process + * New upstream release + * Proper binutils dependency for Debian + * head -1l -> head -n 1 for freebsd + * Cleanup gmp_wrapper code, check for in-place calls as write in one + step is not guaranteed in gmp according to its developers + * Rebuild against binutils 2.15, Closes: #266253, Closes: #263983 + + -- Camm Maguire Tue, 17 Aug 2004 18:22:27 +0000 + +gcl (2.6.4-1) unstable; urgency=high + + * New upstream release + * Make disassemble work when original system directory is gone + * New debian/support files for debconf image default selection support + * More descriptive compiled C function names for use in gprof when + profiling is compiled in + * Compiler fix for proclaimed vararg functions + * Allow sharp numbers to be bignums + * lintian fix in string-match + * Prototype for alloca for lint + * Improve gprof support + * Improve sgc page allocation which optimize-maximum-pages is in + effect and the hole is overrun + * Build a profiling set of images as well for Debian, toggle between + all four by default via debconf + * reset-sys-paths lisp function for moving image installation + directories, show profiling support in banner if present + * Fix typo in sys docs + * reset sys paths on installation + + -- Camm Maguire Thu, 5 Aug 2004 22:48:56 +0000 + +gcl (2.6.3-1) unstable; urgency=high + + * Correctly parse gcc version strings in gmp3 subconfigure on arm + * Fix variable capture error in dotimes macro + * Better sed separator for LI-CC in unixport/makefile + * Fix segfault in string-match + * vs_top=sup -> (reset-top) where possible in compiler. FIXME: a few + items of a different form which need to set *sup-used* too. + * Correct room report to show proper percentages when sgc is on + * Read in RELOC environment variable if set as default in debian/rules + * Remove local bfd libraries from libs variables as their objects are + incorporated into libgcl and as the source directory may not be + available at runtime + * Remove pcl/pcl_gazonk*lsp build-generated files from source + + -- Camm Maguire Thu, 15 Jul 2004 14:26:44 -0400 + +gcl (2.6.2-3) unstable; urgency=low + + * Fix value stack leak in rare compiled call sequence + + -- Camm Maguire Tue, 13 Jul 2004 10:17:02 -0400 + +gcl (2.6.2-2) unstable; urgency=low + + * New upstream point release + + -- Camm Maguire Tue, 13 Jul 2004 10:08:53 -0400 + +gcl (2.6.2-1) unstable; urgency=low + + * gcc-3.4 support + * Proper isnormal default courtesy of Magnus Henoch + * gclclean makefile target and other small makefile changes + * Proper check for C stack array body address in gbc.c and sgbc.c + * New upstream release + * acconfig.h update for isnormal default + * Fix bug in setting elements (si::aset) of 0 rank arrays uncovered by + the random tester + * No -fomit-frame-pointer on mingw + * Backport minimal ansi-test patches from HEAD to enable running of + the random tester + * installed tcl/tk patch for mingw + * Fix banner license detection code in lsp/gcl_mislib.lsp as + 8features* entries are now keywords + * o/makefile changes to work around trailing slash -I arguments gcc + bug on mingw + * Patch to mingwin.c:fix_filename to close long standing 'maxima + ignore-errors filename corruption' bug on mingw + * Check for too large rank supplied to make-array1 + * Fix potential stack overwrite bug in quick_call_sfun/eval.c + * Add -mprferred-stack-boundary=8 on amd64, as constant integers used + in a call must be retrievable with va_arg(,fixnum) + * Revert preferred-stack-boundary option on amd64 as it does not play + well with external libraries, also eliminate -m64 to allow for user + settings. Cast fixnum constant C arguments in gcl_cmploc.lsp + explicitly to (long) to ensure they can be extracted via + va_arg(,fixnum) + * reenable SA_SIGINFO on amd64 to restore SGC there + * Include elf.h in FreeBSD.h + * Allow for elf_abi.h in FreeBSD.h + * Add README.openbsd file + * readme.mingw updates + * solaris.h updates for custreloc option + * Close possibility of malloc failure due to intervening gbc arising + from the misordering of allocation calls + * C_GC_OFFSET is 2 on m68k-linux + * Add release notes, remove gcl document presumably based on dpANS for + now + * Fixup bad extern declaration of signals_handled in usig.c + + -- Camm Maguire Fri, 25 Jun 2004 22:43:52 +0000 + +gcl (2.6.1-39) unstable; urgency=high + + * Fix segfault in referencing (sgc_)type_map out of bounds which can + occurr when C stack is below heap, as on alpha. + * Cleanup compiler warnings on bcmp.c bzero.c and bcopy.c + * Clean up compiler warning in file.d + * Ensure set TLDFLAGS are used in finding DBEGIN in copnfigure.in, for + OpenBSD + + -- Camm Maguire Fri, 7 May 2004 21:50:03 +0000 + +gcl (2.6.1-38) unstable; urgency=low + + * Make *features* entries keywords -- add canonical host cpu and + kernel-system to *features*, disable h files specific + ADDITIONAL_FEATURES macro in main.c + * Fix merge-pathanames bug in concatenating default and supplied + directory lists + * Minor pathname and *features* fixes + * Fix recently introduced configure.in syntax bug + * Minor patches to support big gcl images -- all page integers must be + long ints, need stack space limits that scale with MAXPAGES at least + to allow free_map stack array in sgc_start. FIXME -- right now can + handle situations where page numbers are ints, but npage*PAGESIZE is + a long, need to handle npage >MAX_INT later. This is to support the + 'billion cons element acl2 image' requested by a gcl user + * Revert winnt features and debugging aids in configure.in + * OpenBSD support, gcc warning cleanups for long page integers + + -- Camm Maguire Mon, 3 May 2004 21:34:57 +0000 + +gcl (2.6.1-37) unstable; urgency=high + + * mprotect pages PROT_EXEC as CLEAR_CACHE step on amd64-linux + * Prevent recursive malloc calls for OpenBSD error reporting + * Push dummy 0 time for child runtime on windows to be compatible with + other platforms for now + * Make sure pages are mprotected PROT_EXEC for amd64 support + + -- Camm Maguire Tue, 13 Apr 2004 21:00:22 +0000 + +gcl (2.6.1-36) unstable; urgency=low + + * Improve optimize-maximum-pages algorithm + + -- Camm Maguire Tue, 6 Apr 2004 03:23:40 +0000 + +gcl (2.6.1-35) unstable; urgency=low + + * Fix sigcontext autodetection on sparc + + -- Camm Maguire Sun, 4 Apr 2004 19:26:48 +0000 + +gcl (2.6.1-34) unstable; urgency=low + + * Fix GNU_LD autodetection in configure.in + * Eliminate C_INCLUDE_PATH from shell script wrapper + * Use lisp rather than 'system touch' to make empty map file in + compiler::link + * fix small bug when info is passed bad second argument + * Don't try to open map file if doesn't stat (macosx) + * Add earlier forgotten branch patch to sfaslbfd.c for macosx + * Backport new eval-when keyword support from 2.7 to run random tester + * Perhormance improvement to gcl_seqlib.lsp -- no inner loop over + bignums + * Proper contblock/relblock determination when expanding string + streams + * Proper string type determination for *link-array* + * .ini files depend on plt.h + * plttest.c cannot depend on include.h + * Address longstanding FIXmE in gensym, so that two strings are not + allocated for each gensym + * Fix rare infinite loop bug in array.c + * Import si::info into 'user + * , -> # as sed separator + * Minro warning removals and fixups + * Binary searches through ordered arrays of referred and changed + variables for dramatic compiler performance improvement in the large + case -- support declarations and thereby optimizations of the form + (declare ((vector t) foo)), etc. + * Better 'time macro + * rebuild pcl_gaz* files + * cleanup room report and give more space to modern large heaps + * room report formatting + * Properly gensymmed time macro + * Allow for white space chars in compiled filenames + * Autodetect and work around sbrk randomization, e.g. on Fedora 1 + * Probe for sbrk before probing for randomized sbrk + * Openbsd changes -- maximize data seg resource if possible, avoid + mallocing error message when allocation routines fails + * Fix sigcontext configure tests + * Rename loop-finish -> sloop-finish in sloop package so that sloop + and ansi loop can be used simultaneously + * Handle arguments which are zero in LCM + * Fix typo in configure.in + * Improved dotimes macro which avoids unnecessary fixnum garbage + generation + * Backport of ignorable declaration keyword for new dotimes macro + * si::*OPTIMIZE-MAXIMUM-PAGES* support + * rebuild pcl generated lisp files + + -- Camm Maguire Sat, 3 Apr 2004 19:27:18 +0000 + +gcl (2.6.1-33) unstable; urgency=low + + * Remove extraneous symbols from plt.h, autodetect and correct for + leading underscore in object symbols + * complete readline version detection commit + * Backport support for new eval-when keywords + * Autodetect GNU ld and add -Wl,-Map only when appropriate + + -- Camm Maguire Wed, 10 Mar 2004 22:51:44 +0000 + +gcl (2.6.1-32) unstable; urgency=low + + * Try to automatically determine the form used for the explicitly + compiled in external function addresses in plt.c + * No need to explicitly write cr-lf on windows + * Autodetection of machine on FreeBSD + * Updated defs and h files for FreeBSD courtesy of Mark Murray + * Minor ifdefs needed for FreeBSD + * Refer to exported non-static C stub of fSmake_vector1 in plt.c + (needed on ia64) + * Readline 4.1/4.3 configure magic + + -- Camm Maguire Tue, 9 Mar 2004 01:58:43 +0000 + +gcl (2.6.1-31) unstable; urgency=low + + * Adjustments to vs_top reset logic to clear (hopefully last) + remaining bug found by the random-tester + * Allow args-info-referred-vars to match replaced vars, clearing bug + report submitted by Matt Kauffman + * Rework plt code yet again to be compatible with compiler::link for + axiom, and mingw32 + + -- Camm Maguire Mon, 8 Mar 2004 12:16:46 +0000 + +gcl (2.6.1-30) unstable; urgency=low + + * Fix rsym generated symbol tables for 64 bit platforms + * Make sure 'unwind' in frame.c does nt go below frs_org + * Do not define symbols with no value, either in bfd/rsym, or in + plt.c. Generates a clear and explicit error of an undefined symbol + when we've missed an address + * Define the external symbols known to be written at present in plt.c + * fix some more compiler errors found by the random tester -- all + related to proper unwinding of temporary reductions of vs_top from + te local supremum + + -- Camm Maguire Sat, 6 Mar 2004 02:05:59 +0000 + +gcl (2.6.1-29) unstable; urgency=low + + * Remove implicit dependency on gawk, optimize plt.c a little + + -- Camm Maguire Wed, 3 Mar 2004 16:08:30 +0000 + +gcl (2.6.1-28) unstable; urgency=low + + * make sure bfd fasload initializes dum.sm.sm_object1 for + read_fasl_vector + * When a tagbody contains ccb reference tags, and hence i itself + marked ccb, mark all the clb tags therein ccb too, as the tagbody + environment will be consed in c2tagbody-ccb. FIXME -- review this + logic carefully + * fix typoe in o/sfaslbfd.c + * Add code to unwind redefinitions of the stack supremum in c2expr-top + (used in c2multiple-value-prog1 and c2multiple-value-call in + evaluating arguments) on non-local exit + * Use new temporarry variables holding lisp stack supremum for lint + * Eliminate extraneous warning message when allocating fewer pages + than already allocated + * Rework internal plt symbol address capture + * Cleanup sfaslelf compiler warning + + -- Camm Maguire Wed, 3 Mar 2004 00:27:08 +0000 + +gcl (2.6.1-27) unstable; urgency=low + + * Modify default banner slightly + * Homebrew plt-like mechanism for ensuring that valid internal + addresses exist to which undefined symbols in compiled lisp objects + referring to external shared libraries can be relocated + * Make configure demand gettext when choosing --enable-locbfd + * Make sure references to ldb1, a stub conventionally optimized away, + can be resonled when optimization is turned off + * completion_matches -> rl_completion_matches in gcl_readline.d, + which is what is exported in the headers + + -- Camm Maguire Fri, 27 Feb 2004 23:50:49 +0000 + +gcl (2.6.1-26) unstable; urgency=low + + * Rework compiler::*ld-libs*, compiler::link, and unixport/makefile to + accomodate mingw need for firstfile.o and lastfile.o + * Remove incompatible -fomit-frame-pointer when compiling with -pg + profiling + * Load sys-proclaim.lisp files forimproved linking and smaller object + size across the board, install same for use with compiler::link + * Use pathnames instead of strings in compiler::link, also in image + init files, for Windows + * small mod to unixport/makefile re filtering of firstfile and + lastfile + * Backport zero divisor error cnditions from HEAD for + floor,ceiling,truncate + * Default to debug mode on hppa to work around gcc compiler + optimization bugs + * Add missing m4 and automake files in binutils directory to enable + automake and autoconf here + * Add mach-o specific files from cvs head to local bfd tree + * Add bfd/po makefiles + * Macosx defaults in configure.in + * bfd make and configure file changes to handle mach-o backend + * *gcl-version* -> *gcl-minor-version*,*gcl-extra-version* + * Support for more informative banner reading features list + * Support for both sigbus and sigsegv in sgbc.c as is customary in .h + files + * mach-o compatible changes in sfaslbfd.c + * Support for new debugging section names in sfaslelf.c + * powerpc-macosx h and defs files from cvs head + + -- Camm Maguire Wed, 25 Feb 2004 23:08:59 +0000 + +gcl (2.6.1-25) unstable; urgency=low + + * rl_putc_em a carriage return after invoking readline to ensure the + prompt in rl_putc_em_line is cleared. + * use standard sgc fault recovery element for hppa as recommended by + hppa kernel experts + * Store banner in si::*system-banner* for possible modification + in compatibly licensed programs + * exit with -1 when standard in ends in lisp debug mode + * Backport macosx files from cvs HEAD + * Document system return codes + + -- Camm Maguire Fri, 13 Feb 2004 20:44:54 +0000 + +gcl (2.6.1-24) unstable; urgency=low + + * Revert unixport/makefile link order fix for windows, breaks + compiler::link, find another way + * runtime SGC fault recovery test + * Protect read/fread in case SGC is enabled with safe (restartable) + versions + * SGC on for arm and hppa + * remove fast-link workaround now fixed for windows + * Backport HEAD makefile changes to clean .{c,h,data} files and + new_decl.h, remove said from repository (generated files) + + -- Camm Maguire Thu, 12 Feb 2004 05:56:29 +0000 + +gcl (2.6.1-23) unstable; urgency=low + + * Remove calls to init-readline with new automatic readline setup + + -- Camm Maguire Tue, 27 Jan 2004 20:27:20 +0000 + +gcl (2.6.1-22) unstable; urgency=low + + * Build depend on emacs21 | emacsen + + -- Camm Maguire Fri, 23 Jan 2004 22:01:15 +0000 + +gcl (2.6.1-21) unstable; urgency=low + + * Automatic readline initialization + * Add watch file + * Prevent circular error loops + * Prevent automatic optimization added to CFLAGS by autoconf + * Rework documentation installation in and outside of Debian + * Support user deined predicates at an elementary level in the form + '(satisfies foop) in gcl_predlib.lsp + * Install binary gcd algorithm for ~10% performance increase + * Rescale some default allocation parameters -- bignum allocation by + relblocks by default, default growth parameters are 1 (min), + 0.1*MAXPAGE (max), 0.5 (increase), 0.3 (percent free), holepage is + 4*MAXPAGE/1024, INIT_HOLEPAGE, INIT_NRBPAGE and RB_GETA scale + accordingly + * Clean windows/sysdir.bat + * Check for zero args in new gcd code + * Default hole is maxpages/10, holesize configure option added + * Fix syntax errors in older reloaction code: sfaslelf.c + + -- Camm Maguire Fri, 16 Jan 2004 16:57:50 +0000 + +gcl (2.6.1-20) unstable; urgency=low + + * Fix gcl-doc doc-base files + + -- Camm Maguire Tue, 30 Dec 2003 22:30:39 +0000 + +gcl (2.6.1-19) unstable; urgency=low + + * Fix bug in compiler::c2labels in which *ccb-vs* was missing a ocal + rebind + * Remove duplicate tags from compiled C switch statements + * Minor merges for DARWIN support + * Path to configure to make --enable-emacsdir work + * Check for readline/readline.h header before configuring for readline + * Improve system bfd library location detection + * Make sure external gmp lib is compatible via __GNU_MP_VERSION, else + backoff to local gmp build; prepend externally defined CFLAGS into + output CFLAGS, FINAL_CFLAGS, and NIFLAGS + * Remove --enable-gmp configure option; gmp is required for GCL + * Use --enable-emacsdir in debian/rules, make sure --enable-emacsdir + and --enable-infodir work when arg contains ${prefix} + * Fix typo in chap-6.texi + * Make sure to export SGC define from config.h to cmpinclude.h -- Now + that we used optimized structures in the compiler, we need at least + the definition of SGC_TOUCH there to prevent GBC errors. FIXME -- + handle header dependencies more robustly. Thanks to Robert Boyer + for the report + * Improve SGC define extraction for cmpinclude.h + * Fix variable reference errors which were occurring for compiled + local functions defined within closure-generating or other + environment stack pushing functions when safety is set to 3 (thanks + Paul Dietz for the report.). When constructing local functions and + closures within a 'mother' function, *ccb-vs* will hold the number + of closure environments stacked at the point of each closure + creation or call to a local function. This value is stored as the + cadr of a list pushed onto *local-funs*, and is read when writing + out the C code for the local function or closure, where it is used + to initialize *ccb-vs* and *initial-ccb-vs* for subsequent + processing. The latter is used as the reference point when + addressing variables in wt-ccb-vs, as the former could be still + further incremented within the closure or local function itself. + Local functions as opposed to closures do not increment *ccb-vs* and + do not push the environment. When a local function is defined + within a closure-generating flet/labels, or a tagbody or block which + pushes the environment, the value of *ccb-vs* written to the list + corresponding to the local function can be erroneously incremented + beyond the *initial-ccb-vs* value established before any environment + pushing operations were processed. It is this latter value which is + appropriate for use in wt-ccb-vs, as the local functions, unlike the + closures, receive an environment level with the mother generating + function. We therefore push *initial-ccb-vs* onto the end the list + pushed onto *local-funs* only when defining a local function, and use + it to initialize an added optional variable initialize-ccb-vs in + t3local-fun and t3local-dcfun, which default to the original ccb-vs. + We then bind *initial-ccb-vs* to this new optional parameter instead + of the former *ccb-vs, which was only appropriate for closures. + * Put in rudimentary logic for the selection of stack vs. heap storage + for bignums depending on the frame context. FIXME, this logic is + too conservative at present. SETQ_II and SETQ_IO take an additional + parameter which is malloc when *unwind-exit* is bound and contains + 'frame and alloca otherwise. New macro bignum-expansion-storage. + FIXME, ensure that IDECL does not need similar modification. + * Cleanup a few compiler warnings in the compiler + * Cleanup compiler warning in alloc.c + * Eliminate unneeded transformatio of contniguous pages to other pages + on save-system. + * malloc -> gcl_gmp_alloc in recent setjmp frame protected bignum + allocation + * Add -Wa,--execstack if on an exec-shield enabled system, can be + explicitly added otherwise by setting the CFLAGS variable before the + configure step + * Better execstack flag handling in configure + * Allow for commas in CFLAGS in sed command writing *cc* + * Preliminary gprof profiling support + * Rework html documentation generation and installation, Closes: + #221774 + * Remove parentheses from setf class-name info node in chap-7.texi + + -- Camm Maguire Tue, 30 Dec 2003 16:26:45 +0000 + +gcl (2.6.1-18) unstable; urgency=low + + * Portability patches to makefiles to support non-GNU grep (no -q), + and non-bash sh, C_INCLUDE_PATH=...;export C_INCLUDE_PATH + * copy the global *info* parameter in c1flet and c1labels to prevent + accumulation of old data -- FIXME -- make sure there are no other + copies required, and eventually replace this global parameter with + local variables + * Turn on some optimization on hppa, -O only + * Make all C defined functions installed into lisp static functions to + work around dynamic function descriptors on ia64, Closes: #217484, + Closes: #204789, (STATIC_FUNCTION_POINTERS define in config.h) + + -- Camm Maguire Thu, 6 Nov 2003 15:40:25 +0000 + +gcl (2.6.1-17) unstable; urgency=low + + * Repair weak symbol addition to the bfd symbol table in sfasli.c + * Be more thorough about adding fun-info to call-local info in + gcl_cmpflet.lsp, accompanying simplifications in gcl_cmpeval.lsp + (call-global lists have info updated by args already in (c1args args + info)), small changes in add-info in gcl_cmpinline.lsp, FIXME -- + study rational for *info* special variable in certain places as + opposed to more common copy-info + + -- Camm Maguire Thu, 30 Oct 2003 20:03:22 -0500 + +gcl (2.6.1-16) unstable; urgency=low + + * Fix sh syntax in debian/gcl.sh + * init_or_load1 -> gcl_init_or_load1 in xgcl-2/sysinit.lsp + * Load weak symbols as well as undefined symbols in + bfd_build_symbol_table, for the purposes of the static build + possibility + * Map t and nil stream indicators properly in optimized compiled + references to read_char1 and read_byte1 (in read.d) + + -- Camm Maguire Thu, 23 Oct 2003 16:43:15 +0000 + +gcl (2.6.1-15) unstable; urgency=low + + * Remove imod/ifloor functions in cmpaux.c and directly inline their + fixed equivalents in gcl_cmpopt.lsp + + -- Camm Maguire Mon, 13 Oct 2003 15:04:24 +0000 + +gcl (2.6.1-14) unstable; urgency=low + + * generate less garbage in add-info (gcl_cmpinline.lsp), enabling + maxima compile to complete in a finite time :-) + + -- Camm Maguire Fri, 10 Oct 2003 22:14:04 +0000 + +gcl (2.6.1-13) unstable; urgency=low + + * Fix compiler optimization bug in gcl_cmpopt.lsp -- missing parens + around inliner for max and min + * collect info structures for local functions in flet and labels + processing (gcl_cmpflet.lsp), and pass upwards to call-local and + call-global (gcl_cmpeval.lsp) to fix certain inlining bugs in via + more proper operation of args-info-changed-vars (gcl_cmpinline.lsp, + inline-args, gcl_cmplet.lsp, c2let) + * Fix an obviou int overflow in ifloor (o/cmpaux.c), handle more + proper fixnum/integer determination from declarations later + + -- Camm Maguire Fri, 10 Oct 2003 02:34:11 +0000 + +gcl (2.6.1-12) unstable; urgency=low + + * Restore mpz_to_mpz{1} in gmp_big.c, can be written by compiler + * tk8.4 patches + * Prevent destructive modification of bignum arguments in log_op/mp_op + in gmp_big.c + * Make sure to push stack variables onto newly allocated C variable + when inlining args and args cause side effects, in inline-args, + gcl_cmpinline.lsp + * Fix bug related to gcc-3.3 fixes in set_exponent in num_co.c + * Remove pcl_methods.c patch. as is apparently no longer needed, TODO + -- make sure VOL modifier is inserted where needed to prevent + longjmp clobbers + + -- Camm Maguire Thu, 2 Oct 2003 14:26:43 +0000 + +gcl (2.6.1-11) unstable; urgency=low + + * Add compilation step of compiling all lsp and cmpnew .lsp files from + an interpreted only saved_pre_gcl before the creation of saved_gcl - + - this enables us to use full optimization on these files while + getting the STREF constants right on 32bit and 64bit + * remove 'attic' from comment in gcl_loop.lsp + * configure changes for sizeof(struct contblock) detection + + -- Camm Maguire Wed, 24 Sep 2003 16:09:44 +0000 + +gcl (2.6.1-10) unstable; urgency=low + + * Mac OSX GET_FULL_PATH_SELF + * Preliminary subtypep checking for 'satisfies + * preliminary 'satisfies support in subtypep, more predicate type + pairs and reverse checking + * small compiler change to remove unused C variables from optimized + compiled macros + * Optional compiler init file is called gcl_cmpinit + * fasdmacros.lsp -> gcl_fasdmacros.lsp + * All cmpinit.lsp files named gcl_cmpinit.lsp; allow full lisp + optimization in all directories + * collectfn -> gcl_collectfn in lsp/gcl_auto.lsp + * collectfn -> gcl_collectfn in cmpnew/gcl_make-fn.lsp + * Make sure makefiles can generate sys-proclaim.lsp, regenerate these + files and recompile from lsp + * Rebuild with opts enabled + * Iterate sys-proclaim/rebuild generation once more + * Iterate sys-proclaim/rebuild for pcl and clcs + + -- Camm Maguire Tue, 23 Sep 2003 19:33:27 +0000 + +gcl (2.6.1-9) unstable; urgency=low + + * Close streams in fasldlsym.c + + -- Camm Maguire Tue, 16 Sep 2003 14:57:20 +0000 + +gcl (2.6.1-8) unstable; urgency=low + + * Add processor flag variable to flags in configure.in + * Autoadd full path to kcl_self to enable save-system when user moves + executable and calls without script wrapper + * Add special variables si::*collect-binary-modules* and si::*binary- + modules* as a facility for discovering the list of fasloaded objects + preceding a save-system is required for a subsequent compiler::link + * Add collectfn.lsp to distro + * Rename some files and init_ functions to eliminate namespace + conflicts when building images with compiler::link + * Enable compressed info reading + * Make sure no opt flags are set when enable debug is specified + * Use NIFlAGS to compile new_init with lower opts on ppc to work + around gcc bug, restore full opts to other files + + -- Camm Maguire Sun, 14 Sep 2003 02:18:28 +0000 + +gcl (2.6.1-7) unstable; urgency=low + + * Fix permissions bug in temporary gzipped file handling + * Propagate control changes correctly with package extension + * Newer standards + + -- Camm Maguire Tue, 9 Sep 2003 17:06:56 +0000 + +gcl (2.6.1-6) unstable; urgency=low + + * Remove build-dependency on autoconf as a temporary work around to + Debian autoconf's dependency bug on emacsen-common + + -- Camm Maguire Tue, 9 Sep 2003 15:29:06 +0000 + +gcl (2.6.1-5) unstable; urgency=low + + * Redefine temporary files in elisp/makefile + + -- Camm Maguire Mon, 8 Sep 2003 21:49:09 +0000 + +gcl (2.6.1-4) unstable; urgency=low + + * Fix to sfasli.c to avoid defining symbols in other than *UND* + sections + * Remove some 64 bit warnings + * Turn off def_static on ia64 for now -- its broken + + -- Camm Maguire Sat, 6 Sep 2003 17:22:10 +0000 + +gcl (2.6.1-3) unstable; urgency=low + + * Fix static detection fr ia64; contblock size detection on arm + * Fix gcc verion checking in gmp3 subconfigure, esp. for arm + * Escape all sgc code with #ifdef SGC + + -- Camm Maguire Fri, 5 Sep 2003 21:32:47 +0000 + +gcl (2.6.1-2) unstable; urgency=low + + * Add windows/install.lsp to clean target + * Add in macosx files to stable and cvs head + * Fix bad debelper postinst, Closes: #208765 + + -- Camm Maguire Fri, 5 Sep 2003 13:15:11 +0000 + +gcl (2.6.1-1) unstable; urgency=low + + * New upstream release + * Type-punning warning fixes + * small_fixnum overflow fixes + * off by one fix in cerror + * Fix compiler error which had not recognized defpackage as a package + operation + * Fix tkl.lisp call to open-named-socket + * Make values-list and nreconc signal errors when they should on + dotted lists. + * Avoid use of windows.h types as macros. + * New config.{sub,guess} + * Windows installer updates from CVS HEAD + * fix potential longjmp clobber in read.d;add some windows files to + main makefile clean target; + * Darwin revealed fixes to usig.c and unixtime.c + * Fix gbc time calculation in case of recursive gbc calls + * Run patch_sharp in LSharp_exclamation_reader to handle new case of + defpackage ops at head of fasl vector, required for maxima build + * Special symbol Dotnil has ordinary list Cnil for plist and hpack + * Small fixes for profiling support + * Restore pp() function for debugging; print out undefined symbol + names + * Small patch for fix xgcl demo (thanks Michael Koehne) + * Better bfd symbol table strategy + * Fix bfd table symbol counting for combined_table profiling + * amd64 linux support + * O6 -> O3 + * static linking on ia64 to work around current mechanism for runtime + generated function descriptors + * enable-static configure option + * Fix debian/gcl-doc.docs for latest texinfo file splitting policy, + Closes: #206017 + * Fix typo in o/sfasli.c + * Rework debian package structure to handle stable and cvs packages + simultaneously + * Add gazonk*.lsp to clean target + * syntax fix to lsp/gprof.hc + * Add support for SGC contblock pages + * Fixes to debian/rules + * Remove unused definitions of Vcs + * Increase default maxpages and stack sizes + * Maintain a persisten *system-directory* binding + * Push installed /h directory onto -I flags on cc command line + * Escape old in-package behavior with #ifdef ANSI_COMMON_LISP + * define HAVE_XDR in linux.h + * reduce resolution of contblock mark_table in gbc.c to match new + minimum granularity introduced via CPTR_ALIGN + * Remove exit function in main.c + + -- Camm Maguire Thu, 4 Sep 2003 02:20:52 +0000 + +gcl (2.5.3-2) unstable; urgency=low + + * gcc-3.3 all platforms + + -- Camm Maguire Mon, 7 Jul 2003 16:10:25 +0000 + +gcl (2.5.3-1) unstable; urgency=low + + * New upstream release + * Restore object_to_float and object_to_double, cmpaux.c, Closes: #195470. + * Remove obsolete functiion multiply-bignum-stack from documentation, + si-defs.texi + * Unstatic object_to_float, object_to_double + + -- Camm Maguire Mon, 2 Jun 2003 12:38:03 -0400 + +gcl (2.5.2-1) unstable; urgency=low + + * New upstream release + * Cleanup xdrfuns.c for Axiom + * Reenable xgcl build + + -- Camm Maguire Thu, 20 Mar 2003 09:15:54 -0500 + +gcl (2.5.1-1) unstable; urgency=high + + * some optimization now on hppa + * Add RELEASE-2.5.1 file + * Add dedication notice to the memory of W. Schelter + + -- Camm Maguire Sun, 2 Mar 2003 10:20:26 -0500 + +gcl (2.5.0.cvs20020625-80) unstable; urgency=low + + * enable japi configure flag, defaults to no + * enable -mlongcall on ppc when using gcc 3.3 or higher + * int -> fixnum in DEFUN function arguments for safety -- ensures + pointers and integers passed by lisp are of same size + * MYmake_fixnum macro simplification + * ufixnum typedef + * Prototypes for cmod et.al. -- restoring maxima build on ia64 + * Fix unaligned access message on ia64 generated by DFLT_aet_fix + * Integer va_arg uses fixnum + * Define __*i3 symbols used by GCL, supplied by libc, and written into + some GCL compiled objects, restores ARM build with ANSI image + * num_log.c miscompilation on ia64 apparently fixed, Closes: #156291 + * Ensure cmpinclude.h up to date in main makefile + + -- Camm Maguire Sat, 1 Mar 2003 17:33:29 -0500 + +gcl (2.5.0.cvs20020625-79) unstable; urgency=low + + * Fix Debian package install bug + + -- Camm Maguire Thu, 27 Feb 2003 23:17:55 -0500 + +gcl (2.5.0.cvs20020625-78) unstable; urgency=low + + * Add config.log config.status and config.cache to clean target + * Remove xgcl-2/debian directory + * Update clcs/sys-proclaim.lisp + + -- Camm Maguire Thu, 27 Feb 2003 18:48:38 -0500 + +gcl (2.5.0.cvs20020625-77) unstable; urgency=low + + * Lintian cleanups + * Don't strip libansi_gcl.a, need .data at end of .o, as with libgcl.a + * Take newlines out of doc string for init-cmp-anon + * Cleanup gcc-3.2 compiler warning + * 64 bit STREF fixes + * pcl and clcs need to have C rebuilt afresh, as 64 bit machines write + different STREF offsets into the C files + * Rework Debian package build a bit + * README.Debian explaining the toggling of the ANSI image + * Typo in debian/rules + * Remove debian/gcl.conffiles + + -- Camm Maguire Thu, 27 Feb 2003 15:56:11 -0500 + +gcl (2.5.0.cvs20020625-76) unstable; urgency=low + + * Debian Priority is optional + * Configure lowest common denominator on m68k to m68020 -- gcc-3.2 + can't handle m68000 -- no __mulsi3 + * Fix bit array bug + * Add upgraded-array-element-type + * Misc typep and subtypep fixes + * Proper error handling in certain array.c functions + * First needs exactly one arg + * Proper error handlin in LAST + * bit array allocation fixes in num_log.c + * eliminate Iapply_fun_n1 + * Dummy system find-class in traditional image, overwritten by pcl + version in ANSI + * Invalid variable is a program error, not a symbol is a type error + * Attempt at uninterned symbol support as slot names + * defstruct changes for ANSI conc-name handling + * Rework ansi build to follow existing pattern for traditional image, + enabling preliminary ansi support on dlopen systems + * Fix broken mingw probe in main makefile + * Rename pcl and clcs files to avoid init name conflict on dlopen + systems + * sys-proclaim for clcs + * Compiler goto indentation + * Compiler pointer cast in call_or_link_closure + * *keep-gaz* compiler variable to save anonymously generated lisp + * si::init-cmp-anon function to initialize anonymously generated and + compiled lisp from .text section of running executable + * Debian/rules builds and ships both images + * Check for small fixnum in make_fixnum macro + * Pass real integers to array functions to minimize fixnum garbage + * Larger SHARP_EQ_CONTEXT_SIZE in read.d + * Shadowing-import instead of import dummy symbols into common-lisp in + ansi_cl.lisp + * Rework object definition in makefiles + * Remove old gmp directory + * Remove old tests directory + * Reinsert JAPI configuration + * Spruce up clean target + * Use saved_gcl to recompile cmpnew files + * Toggle ansi image with GCL_ANSI environment variable + * Version 2.5.1 + + -- Camm Maguire Wed, 26 Feb 2003 21:31:04 -0500 + +gcl (2.5.0.cvs20020625-75) unstable; urgency=low + + * Export truename for dlopen systems + + -- Camm Maguire Fri, 14 Feb 2003 23:31:15 -0500 + +gcl (2.5.0.cvs20020625-74) unstable; urgency=low + + * Remove duplicates in apropos a la clisp + * Use static where possible, remove unused functions, decrease global + symbol count by about 1/3 (~ 600 global functions) + * Inline optimize cmod,cplus,ctimes and cdifference like maxima + * eliminate make-pure-array from lfun_list.lsp, not defined + * Prototypes for all possible compiler generated function calls + * relative symlink for cmpinclude.h in Debian package + + -- Camm Maguire Fri, 14 Feb 2003 20:17:31 -0500 + +gcl (2.5.0.cvs20020625-73) unstable; urgency=low + + * typep fixes for class types + * m68k Build-depend on gcc-2.95 as a temporary work around to bug + 179807 + * gcc-3.2 warning cleanups + * bfd_boolean syntax support for newer binutils + * gcc-3.2 on powerpc can't yet handle -O2 and higher + * Reenable gcc-3.2 for m68k and do some guesswork in configure + + -- Camm Maguire Mon, 10 Feb 2003 13:47:00 -0500 + +gcl (2.5.0.cvs20020625-72) unstable; urgency=high + + * Fix to siLbit_array_op for 0 dimension arrays + * Fixed aref of short-float vector + * nconc can take dotted lists + * tailp returns t if first arg is nil + * Repair nconc and tailp fixes + * varargs->stdarg for gcc 3.3 and higher + + -- Camm Maguire Sun, 9 Feb 2003 16:57:33 -0500 + +gcl (2.5.0.cvs20020625-71) unstable; urgency=high + + * ansi changes to sloop.lsp and conditions.lisp to fix symbol tests + * :definition-before-pcl -> definition-before-pcl + * Allow spaces in pathnames + * Significant fixes to gmp_num_log.c affecting bitwise ops on bignums + * Fix test segfault arising from faulty structure-type-included-type- + name in gcl-low.lisp ; Thanks Peter + * aref1 -> row-major-aref + * Fixes to certain numerical functions to handle denormalized floating + point numbers + * Number of argument check in IapplyVector + * Print offset bit vectors correctly + * Correct precision for formatting short and long doubles + * Added si::modf + * Do not trigger error in IapplyVector if max args is zero + * Fixes to with-package-iterator to cleanup compiler warnings + * :invalid-variable is a type error + * No max arg checking if &key or &rest present + * proper defun declarations in listlib.lsp + * class specifiers in typep, subtypep and coerce + * Corrections to allow-other-key processing in bind.c + * eval sfuns with argument error checking (in one place) + * copy-structure takes only one arg + * si::classp, si::class-of, and si::class-precedence-list overwritten + by pcl analogs when compiling ansi + * recompiled core lsp and compiler files + * restore dvi and html doc build for non-mingw + + -- Camm Maguire Fri, 24 Jan 2003 13:55:11 -0500 + +gcl (2.5.0.cvs20020625-70) unstable; urgency=high + + * loop fixes + * configure fixes + * :common-lisp in *features* + * :definition-before-clcs -> definition-before-clcs + * protect against sgc segfault within fread in fasdump.c -- fixes m68k + acl2 build + * SGC for s390 + + -- Camm Maguire Thu, 5 Dec 2002 08:02:17 -0500 + +gcl (2.5.0.cvs20020625-69) unstable; urgency=high + + * eval fix + * \-mlong-calls for arm + + -- Camm Maguire Mon, 25 Nov 2002 08:35:27 -0500 + +gcl (2.5.0.cvs20020625-68) unstable; urgency=high + + * enable emacsdir configure option + * reordered configure X lib detection for solaris + * redo integer declarations for gmp bignums to avoid compiler warnings + * Clear large and negative count errors for remove/delete + * Loop error fixes + * cache flush with page granularity on m68k + + -- Camm Maguire Thu, 21 Nov 2002 17:44:30 -0500 + +gcl (2.5.0.cvs20020625-67) unstable; urgency=high + + * Align cache flushes for powerpc and m68k on 32 byte boundaries, + should fix acl2 build + * Removed diagnostic SIGILL trapping in cmpaux.c + + -- Camm Maguire Tue, 12 Nov 2002 23:25:49 -0500 + +gcl (2.5.0.cvs20020625-66) unstable; urgency=high + + * Fix SIGILL trap in cmpaux.c + + -- Camm Maguire Mon, 11 Nov 2002 11:14:07 -0500 + +gcl (2.5.0.cvs20020625-65) unstable; urgency=high + + * Miscellaneous Freebsd patches + * non-recursive with-package-iterator + * map-into fill-pointer fixes + * changes to the user-init mechanism for portable acl2 build + + -- Camm Maguire Sun, 10 Nov 2002 12:33:59 -0500 + +gcl (2.5.0.cvs20020625-64) unstable; urgency=low + + * Fix epsilon calculations again to reenable arm build + + -- Camm Maguire Fri, 1 Nov 2002 07:08:33 -0500 + +gcl (2.5.0.cvs20020625-63) unstable; urgency=low + + * Add versioned dependency on the gcc used to build gcl + + -- Camm Maguire Tue, 29 Oct 2002 16:20:22 -0500 + +gcl (2.5.0.cvs20020625-62) unstable; urgency=low + + * with-package-iterator modifications + * with-package-iterator uses labels to correctly provide for recursion + * Fix doc directory problem with install target in info/makefile + * Fix info dir setting in configure + * Priority extra + + -- Camm Maguire Mon, 28 Oct 2002 23:45:07 -0500 + +gcl (2.5.0.cvs20020625-61) unstable; urgency=low + + * Placeholder support for optional condition in find-restart + * defpackage error on importing non-existent symbols + * working with-package-iterator macro + * various package errors reported as :package-error + * Destructuring-bind fixes + * delete-package error fix + * pcl functions use pcl-destructuring-bind for now -- fix later + * Trigger error if function calls use too many 'values' + * Maximum values increased to 50 + * Enable previously failing tests in multiple-value-{setq,prog1}.lsp + * prototype for system_time_zone_helper + * Initial changes for solaris support + * make -> $(MAKE) in makefiles + * Incorporated main GCL (ANSI) Lisp Documentation in distribution + + -- Camm Maguire Mon, 28 Oct 2002 04:31:33 -0500 + +gcl (2.5.0.cvs20020625-60) unstable; urgency=low + + * Still better acosh, courtesy of Barton Willis + * Better epsilon contant determination in ieee case + * Implicit tagbody in do-symbols and do-all-symbols + * Better epsilon handling in ieee case + * Add setf (values ... support + * invalid-function errors are type errors + * ecase and ccase take t and otherwise clauses + * ECASE/CCASE test fixes + * setf values fixes to use setf instead of setq when target value is + not a symbol + * ETYPECASE/CTYPECASE can take t and otherwise + * Backout of restart-clusters export + * fix handler.lisp + * Fix to bfd/GBC interaction + + -- Camm Maguire Wed, 23 Oct 2002 08:38:08 -0400 + +gcl (2.5.0.cvs20020625-59) unstable; urgency=low + + * wrong number of arguments, keyword errors in lambda list bindings, + are program errors + * acosh fix at -1.0 + * New config.sub and config.guess files and automatic updates in + binutils, gmp, and gmp3 subdirs + + -- Camm Maguire Wed, 16 Oct 2002 11:38:56 -0400 + +gcl (2.5.0.cvs20020625-58) unstable; urgency=low + + * GENSYM fixes + * add complement and constantly + * import certain symbols into common-lisp package + * Fix makefile bug in install target + * Prepend instead of overwrite C_INCLUDE_PATH in shell wrapper + * More shell variable fixes in main makefile + * Corrected order of push and pushnew + * Set bfd_error appropriately + * Report function for package-error in condition-definitions.lisp;fix + internal-package-error deinition and handling;export *restart- + clusters* to user error code specified in handler-case;package-error + error formatting changes;dummy optional argument added to compute- + restarts (for now);Paul Dietz patch to defpackage.lsp fixing several + tests (thanks);export/unexport error handling fixes + * Recompile c,h and data files + * Fix number of argument errors in debug.lsp;documentation support for + packages in defpackage.lsp and module.lsp;do-symbols loops over + inherited symbols too in packlib.lsp + * Reworked EXTRAS variable handling in unixport/makefile + * Build-depend on autotools-dev and automatic update of config.sub and + config.guess;newer config.sub and config.guess in cvs tree; Closes: + #164526 + * Remove stray comments in package.d + * elt errors of type type error + * bad-sequence limit returns type error + + -- Camm Maguire Tue, 15 Oct 2002 15:39:19 -0400 + +gcl (2.5.0.cvs20020625-57) unstable; urgency=low + + * Capitalization changes to names of special characters;graphic-char-p + fix + * fix shadowing of existing symbols in package.d + * (simple-)base-string not a subtype of (simple-)vector + * add package-error condition(preliminary);hash conditions only by the + error name, not the format string;pass error types for both + correctable and non-correctable situations;eliminate duplicate + loading of clcs/package.lisp;Allow t doc-types in documentation + (returning nil) for now;fix final type errors in predlib.lsp + (regarding base-string);other error functions to pass continuable + errors (needs cleaning up);package designators can be + characters;delete-package added;make-package doesn't :use lisp by + default;in-package returns error if package does not exist instead + of making the package(relatively big change -- need to address + instances of in-package in .lsp code);call make-package on relevant + packages in init_gcl.lsp.in and pcl/sys-package.lisp; + * \-ffunction-sections for hppa with no-optimization -- enables first + maxima build here + * separate lisp variables to specify optimization flags for level 2 + and 3 + * symbol-name throws a type error on bad input + * tk8.2 -> tk8.3 + * Fix bug in main makefile + * Newlines at end of test files + + -- Camm Maguire Wed, 9 Oct 2002 15:04:41 -0400 + +gcl (2.5.0.cvs20020625-56) unstable; urgency=high + + * ansi-test corrections; extra-libs option to LINK function; LINK doc + change; subtypep and string changes to pass more tests + * Add method-combination and structure-object symbols for ansi;remove + unused variables in debug.lsp;remove in-package system from + defstruct.lsp;make-keyword and defmacro temporary function + placeholders in destructuring_bind.lsp;predlib changes to fix ansi- + test type errors;break-call takes 2 args (sys-proclaim.lisp);char + and char-set protected by string dimension not fillpointer in + string.d;fix bug in string.d:member_char for vector types;redefine + slot reader and writer functions in pcl/impl/gcl/gcl-low.lisp + + -- Camm Maguire Sat, 5 Oct 2002 14:33:46 -0400 + +gcl (2.5.0.cvs20020625-55) unstable; urgency=high + + * Add LINK documentation to info pages + * 0 length last support + * make-sequence error check for 'null type and non-zero size + * Dotted-list support in member + * Reworked dotnil definitions and support macros + * add compile-file-pathname + * setup C_INCLUDE_PATH env variable in gcl shell wrapper + * POSITIVE-FIXNUM variable type,simple-error->type error where + indicated by various ansi tests, eq->eql in ldiff and tailp;proper + lists only in member et. al. + * rev keyword for member1 to reverse test arguments + * specific-error function to pass a given type of error from lisp + * set-exclusive-or preserves order of test arguments + * type-errors where appropriate in make-sequence + * nil keys accepted in remove/delete et.al. + * Reworked linking command line to ensure that certain symbols are + resolved in libgcl.a as opposed to certain system libraries, e.g. + gmp + * new gmp for m68k;no -ffloat-store for m68k a requested by user due + to performance impact (will alter test results in maxima + accordingly) + * libgclp.a for objects to be overriden by the C library if necessary + * readably support + * boolean type + * Missing ansi type support + * subtype code for boolean + * add missing ansi types as known types + * other preliminary subtype code for missing ansi types + * rework result-type check in make-sequence + * :element-type support in make-string (preliminary) + * (char ignores fill-pointer + * remove -O4 from debian/rules + + -- Camm Maguire Thu, 3 Oct 2002 01:52:45 -0400 + +gcl (2.5.0.cvs20020625-54) unstable; urgency=high + + * Fix delete et. al. :from-end error; typo in gbc.c + * character and string-char equal in type hierarchy + * concatenate/make-sequence fixes + * merge takes nil key argument + * make-sequence checks size against result type + * install endp macro for dotted list support + + -- Camm Maguire Tue, 24 Sep 2002 14:57:44 -0400 + +gcl (2.5.0.cvs20020625-53) unstable; urgency=high + + * Sleep with (in principle) microsecond precision + * nth-value macro added + * \-ffloat\-store and warning cleanups for m68k + * Compile hppa with debugging, will get a build but a broken one, ok + for now, Closes: #159591 + + -- Camm Maguire Fri, 20 Sep 2002 09:48:35 -0400 + +gcl (2.5.0.cvs20020625-52) unstable; urgency=high + + * Fixed gcc version bug in debian/rules + + -- Camm Maguire Thu, 12 Sep 2002 18:00:50 -0400 + +gcl (2.5.0.cvs20020625-51) unstable; urgency=high + + * static gmp for m68k + + -- Camm Maguire Thu, 12 Sep 2002 09:33:03 -0400 + +gcl (2.5.0.cvs20020625-50) unstable; urgency=high + + * Reworked static gmp target for new libgcl.a;gcc-3.2 for + hppa,ia64,and arm;libgmp2-dev for m68k;no rsym with + dynsysbfd;build_symbol_table earlier to shrink table size; + + -- Camm Maguire Thu, 12 Sep 2002 00:39:17 -0400 + +gcl (2.5.0.cvs20020625-49) unstable; urgency=high + + * Use old gmp for m68k until can pin down test failure with gmp3 + + -- Camm Maguire Tue, 10 Sep 2002 00:36:10 -0400 + +gcl (2.5.0.cvs20020625-48) unstable; urgency=high + + * Rework build and install so that custom images can be made without + the source tree, even when using dlopen + + -- Camm Maguire Mon, 9 Sep 2002 23:26:47 -0400 + +gcl (2.5.0.cvs20020625-47) unstable; urgency=high + + * Install cmpinclude.h in system include directory + + -- Camm Maguire Thu, 29 Aug 2002 23:31:55 -0400 + +gcl (2.5.0.cvs20020625-46) unstable; urgency=high + + * Keep a *much* smaller piece of gmp.h in cmpinclude.h, reducing image + size by almost 100k + * Check for _SHORT_LIMB and _LONG_LONG_LIMB in configure + * Remove build specific include directories from compile command in + final executable + * Include local regexp.h explicitly in cmpinclude.h, to eliminate + intereference with system regexp.h, and to fix bug in which gcl + compilation depended on existing build directories + * Correctly add directory paths to extra gmp file targets in + unixport/makefile for m68k + + -- Camm Maguire Thu, 29 Aug 2002 21:56:28 -0400 + +gcl (2.5.0.cvs20020625-45) unstable; urgency=high + + * Fix typo in rshift target for m68k + + -- Camm Maguire Wed, 28 Aug 2002 18:02:00 -0400 + +gcl (2.5.0.cvs20020625-44) unstable; urgency=high + + * Handle second argument to last; treat dotted lists correctly in + ldiff et. al., tailp fix + * optional key argument for assoc-if et.al.;eval getf deflt if in setf + * Fix infinite loop in assoc-if et.al. + * X_LIBS and X_CFLAGS determination in configure script + + -- Camm Maguire Wed, 21 Aug 2002 18:22:37 -0400 + +gcl (2.5.0.cvs20020625-43) unstable; urgency=high + + * Larger ihs stack;fix array-total-size-limit;check negative + fillp;allow #P + * don't make common_lisp package when not configuring with --enable- + ansi + * Patch gmp3/mpn/m68k/{l,r}shift.asm, restore gmp3 to m68k build + * Dynamic libgmp support, overriding with patched functions from local + source where necessary + + -- Camm Maguire Sun, 18 Aug 2002 12:10:55 -0400 + +gcl (2.5.0.cvs20020625-42) unstable; urgency=high + + * copy ansidecl.h and symcat.h in h/ for local bfd builds + * localize bfd.h includes to sfaslbfd.c + * take bfd/po out of the build loop + * import xgcl-2, but don't build by default + * oldgmp configure option, and made default for m68k as temporary + workaround + + -- Camm Maguire Mon, 12 Aug 2002 23:49:09 -0400 + +gcl (2.5.0.cvs20020625-41) unstable; urgency=high + + * Minor rules revision for i164 + + -- Camm Maguire Sun, 11 Aug 2002 13:49:03 -0400 + +gcl (2.5.0.cvs20020625-40) unstable; urgency=high + + * revamp CONST configure test for certain bfd versions + + -- Camm Maguire Sun, 11 Aug 2002 12:31:35 -0400 + +gcl (2.5.0.cvs20020625-39) unstable; urgency=high + + * gcc-3.1 for ia64 fixes a compilation bug in num_co.c for -O3 and + higher -- code takes address of a variable kept in a register + * compile num_log.c with -O only on ia64 to work around compiler bug + + -- Camm Maguire Sun, 11 Aug 2002 08:53:03 -0400 + +gcl (2.5.0.cvs20020625-38) unstable; urgency=high + + * check for long c statck addresses, fixing NULL_OR_ON_C_STACK macro + for ia64 + * Remove error in clean target + + -- Camm Maguire Sat, 10 Aug 2002 13:20:08 -0400 + +gcl (2.5.0.cvs20020625-37) unstable; urgency=high + + * Replace tmpnam and mktemp with less dangerous mkstemp + + -- Camm Maguire Fri, 9 Aug 2002 19:45:52 -0400 + +gcl (2.5.0.cvs20020625-36) unstable; urgency=high + + * Fix rsym compilation when not using bfd + + -- Camm Maguire Fri, 9 Aug 2002 19:10:16 -0400 + +gcl (2.5.0.cvs20020625-35) unstable; urgency=high + + * Don't build bfd/po subdir + * Build-depend on automake and gettext + + -- Camm Maguire Fri, 9 Aug 2002 14:36:58 -0400 + +gcl (2.5.0.cvs20020625-34) unstable; urgency=high + + * fix zero length array support + * reverse configure order for bfd and libiberty + + -- Camm Maguire Fri, 9 Aug 2002 11:52:38 -0400 + +gcl (2.5.0.cvs20020625-33) unstable; urgency=high + + * chmod +x for subconfigures + * dlopen for appropriate arches in debian/rules + * add custreloc configure option + + -- Camm Maguire Fri, 9 Aug 2002 10:16:55 -0400 + +gcl (2.5.0.cvs20020625-32) unstable; urgency=high + + * Local bfd build option to prepare for arch-specific patches + * Try default gmp3 build on m68k + * Fix merge-pathnames + + -- Camm Maguire Fri, 9 Aug 2002 00:13:16 -0400 + +gcl (2.5.0.cvs20020625-31) unstable; urgency=high + + * #undef bool in object.h for some gcc-3.1 installations + * New number_tan implementation using real tan, so optimized compiled + code will find symbol in -lm + + -- Camm Maguire Tue, 6 Aug 2002 18:37:52 -0400 + +gcl (2.5.0.cvs20020625-30) unstable; urgency=high + + * fix bug in cmpif.lsp and recompile compiler + * \-O6 \-fomit\-frame\-pointer for Linux, speed gain of ~ 10% + * clean saved_gcl_pcl + + -- Camm Maguire Mon, 5 Aug 2002 16:34:33 -0400 + +gcl (2.5.0.cvs20020625-29) unstable; urgency=high + + * Back out of hppa assembler register flush for hppa, apparently issue + is cleared by long/object function declaration fix + * Remove ansi2knr.1 man page, Closes: #155067 + * hppa still has gc leak, possibly due to faulty setjmp. Try Lamont + Jones' latest assembler to flush regs + + -- Camm Maguire Fri, 2 Aug 2002 20:50:21 -0400 + +gcl (2.5.0.cvs20020625-28) unstable; urgency=high + + * SGC support for alpha + * generic gmp3 build for m68k + * compiler changes to declare all functions as returning object, with + functions that actually return long being cast appropriately + * back out of m68k hack in eval.c and funlink.c + + -- Camm Maguire Fri, 2 Aug 2002 18:22:04 -0400 + +gcl (2.5.0.cvs20020625-27) unstable; urgency=high + + * Use generic lshift.c in gmp3 for m68k + * use SGC for ia64 + * m68k workaround, cast (object(*)()) to (long(*)()) in funlink.c and + eval.c + * GBC register spiil asm for hppa + * fix hash_equal declaration error in hash.d + + -- Camm Maguire Thu, 1 Aug 2002 18:12:49 -0400 + +gcl (2.5.0.cvs20020625-26) unstable; urgency=high + + * Remove extra load of tkl.o in install target of main makefile + * gcc-3.1 for hppa + * Remove gcc version spec for m68k + * \-fPIC for hppa, needed for dlopen + * cleanup gcc 3.1 warning in funlink.c + * cc instead of ld for -shared linking in fasldlsym.c (needed for + hppa) + + -- Camm Maguire Wed, 31 Jul 2002 18:46:54 -0400 + +gcl (2.5.0.cvs20020625-25) unstable; urgency=high + + * Move chmod +x gmp3/* into debian/rules + * Remove gclm.bat from Debian package + * Build-Depend on autoconf, Closes: #154909 + + -- Camm Maguire Wed, 31 Jul 2002 09:44:20 -0400 + +gcl (2.5.0.cvs20020625-24) unstable; urgency=high + + * chmod +x gmp3/configure + + -- Camm Maguire Wed, 31 Jul 2002 07:55:17 -0400 + +gcl (2.5.0.cvs20020625-23) unstable; urgency=high + + * 64bit SGC support + * SGC on by default for sparc-linux and mips(el)-linux + * Optimized logxor funtion + * Check for MP_LIMB_SIZE in fasdump.c, for 64bit support + * gbc fix for ia64 + * gmp3 import for ia64 + * system bzero, bcmp, and bcopy function prototypes + + -- Camm Maguire Tue, 30 Jul 2002 23:11:58 -0400 + +gcl (2.5.0.cvs20020625-22) unstable; urgency=high + + * ElfW macros in rsym*.c for 64bit + * Allow for 8 byte gmp mp_limbs + + -- Camm Maguire Thu, 25 Jul 2002 18:52:37 -0400 + +gcl (2.5.0.cvs20020625-21) unstable; urgency=high + + * Support for dlopen object loading where bfd is not yet working -- + ./configure --enable-dlopen + + -- Camm Maguire Thu, 25 Jul 2002 15:08:05 -0400 + +gcl (2.5.0.cvs20020625-20) unstable; urgency=high + + * Cleanups for --disable-bfd option + + -- Camm Maguire Wed, 24 Jul 2002 15:05:28 -0400 + +gcl (2.5.0.cvs20020625-19) unstable; urgency=high + + * 64bit fixes + + -- Camm Maguire Wed, 24 Jul 2002 12:16:42 -0400 + +gcl (2.5.0.cvs20020625-18) unstable; urgency=high + + * misc. lintian cleanups, mostly for 64 bit + + -- Camm Maguire Tue, 23 Jul 2002 23:35:03 -0400 + +gcl (2.5.0.cvs20020625-17) unstable; urgency=high + + * Fixed typeo in error.c preventing arm compilation + + -- Camm Maguire Mon, 22 Jul 2002 17:18:18 -0400 + +gcl (2.5.0.cvs20020625-16) unstable; urgency=high + + * Fix bad on_stack_list_vector args + + -- Camm Maguire Mon, 22 Jul 2002 16:10:16 -0400 + +gcl (2.5.0.cvs20020625-15) unstable; urgency=high + + * More lint changes for sundry arches + * Fixed bug in Iapply_ap + + -- Camm Maguire Sat, 20 Jul 2002 23:40:33 -0400 + +gcl (2.5.0.cvs20020625-14) unstable; urgency=high + + * include stdarg.h when defining _GNU_SOURCE + + -- Camm Maguire Sat, 20 Jul 2002 18:47:43 -0400 + +gcl (2.5.0.cvs20020625-13) unstable; urgency=high + + * Proper va_dcl declarations + + -- Camm Maguire Sat, 20 Jul 2002 10:40:02 -0400 + +gcl (2.5.0.cvs20020625-12) unstable; urgency=high + + * cvs updates for missing ptrdiff_t + + -- Camm Maguire Sat, 20 Jul 2002 08:41:37 -0400 + +gcl (2.5.0.cvs20020625-11) unstable; urgency=high + + * cvs changes to compile cleanly with -Wall + + -- Camm Maguire Sat, 20 Jul 2002 02:59:33 -0400 + +gcl (2.5.0.cvs20020625-10) unstable; urgency=high + + * Architecture any, though still have some issues + + -- Camm Maguire Fri, 12 Jul 2002 19:02:09 -0400 + +gcl (2.5.0.cvs20020625-9) unstable; urgency=high + + * cvs commits for 64bit support + + -- Camm Maguire Fri, 12 Jul 2002 18:01:21 -0400 + +gcl (2.5.0.cvs20020625-8) unstable; urgency=high + + * NULL_OR_ON_C_STACK macro correction for m68k + + -- Camm Maguire Fri, 12 Jul 2002 14:37:48 -0400 + +gcl (2.5.0.cvs20020625-7) unstable; urgency=high + + * arm is bigendian + + -- Camm Maguire Wed, 10 Jul 2002 18:04:22 -0400 + +gcl (2.5.0.cvs20020625-6) unstable; urgency=high + + * cvs updates for arm build + + -- Camm Maguire Tue, 9 Jul 2002 16:09:26 -0400 + +gcl (2.5.0.cvs20020625-5) unstable; urgency=high + + * CC environment variable setting in debian/rules to aid in porting + * gcc 2.95 for m68k + + -- Camm Maguire Sat, 6 Jul 2002 23:00:23 -0400 + +gcl (2.5.0.cvs20020625-4) unstable; urgency=high + + * gcc 3.0 for arm + * cachectl header for m68k + + -- Camm Maguire Mon, 1 Jul 2002 15:47:53 -0400 + +gcl (2.5.0.cvs20020625-3) unstable; urgency=high + + * Better libbfd detection for arm/alpha + + -- Camm Maguire Wed, 26 Jun 2002 17:27:21 -0400 + +gcl (2.5.0.cvs20020625-2) unstable; urgency=high + + * s390 support + + -- Camm Maguire Tue, 25 Jun 2002 21:25:35 -0400 + +gcl (2.5.0.cvs20020625-1) unstable; urgency=high + + * CVS updates, new s390 arch + + -- Camm Maguire Tue, 25 Jun 2002 19:26:36 -0400 + +gcl (2.5.0.cvs20020610-2) unstable; urgency=high + + * cvs updates + + -- Camm Maguire Thu, 13 Jun 2002 08:42:32 -0400 + +gcl (2.5.0.cvs20020610-1) unstable; urgency=high + + * cvs updates + + -- Camm Maguire Wed, 12 Jun 2002 23:04:57 -0400 + +gcl (2.5.0.cvs20020523-2) unstable; urgency=high + + * configure updates for better tk detection + + -- Camm Maguire Fri, 24 May 2002 18:50:22 -0400 + +gcl (2.5.0.cvs20020523-1) unstable; urgency=high + + * New upstream release + + -- Camm Maguire Fri, 24 May 2002 18:50:22 -0400 + +gcl (2.5.0.cvs20020429-1) unstable; urgency=high + + * Build-Depend on tk8.2-dev, Closes: #144330 + * New cvs updates + * Added sparc to arch list, Closes: #143465 + + -- Camm Maguire Mon, 29 Apr 2002 23:07:36 -0400 + +gcl (2.5.0.cvs20020219-2) unstable; urgency=medium + + * flavor ->debian-emacs-flavor in emacsen-startup + + -- Camm Maguire Mon, 4 Mar 2002 14:29:59 -0500 + +gcl (2.5.0.cvs20020219-1) unstable; urgency=medium + + * Updated package descriptions, Closes: #134402 + * Static linking of libbfd, Closes: #134647 + * Gcl currently only available on i386, arm and m68k as specified in + the Architecture control field, Closes: #133912 + + -- Camm Maguire Tue, 19 Feb 2002 12:04:29 -0500 + +gcl (2.5.0.cvs-3) unstable; urgency=medium + + * Build-depend on texi2html, Closes: #133699 + + -- Camm Maguire Wed, 13 Feb 2002 16:22:35 -0500 + +gcl (2.5.0.cvs-2) unstable; urgency=medium + + * Put in versioned dependency on binutils for libbfd support, rebuilt + with latest binutils, Closes: #133004 + + -- Camm Maguire Tue, 12 Feb 2002 13:19:12 -0500 + +gcl (2.5.0.cvs-1) unstable; urgency=medium + + * Latest patches from CVS, enabling libbfd relocations, among other + things + * /etc/emacs/site-start.d/50gcl.el as conffile, Closes: #132137 + * limited arm and m68k support + + -- Camm Maguire Mon, 4 Feb 2002 09:32:29 -0500 + +gcl (2.5.0-1) unstable; urgency=medium + + * New maintainer + * New upstream release + * New release so far builds only on i386, Closes: #116070, Closes: + #123371 + * New release so far builds only on i386, Closes: #115041 + * Gcl must currently use its own copy of gmp, as the upstream version + of gmp uses malloc, which interferes with gcl's garbage collection + and relocation scheme. The change from malloc to alloca has been + suggested to upstream gmp developers. Closes: #108910 + * Tcl/Tk support now in. Closes: #113197 + + -- Camm Maguire Fri, 21 Dec 2001 00:03:43 -0500 + +gcl (2.4.0-3) unstable; urgency=medium + + * Make gcl use libgmp3 package. (closes: #108910) + * Remove tk support. (closes: #108909) + * Fix stupid missing dependency line. (closes: #108907, #108908) + * Removed readme.mingw from the debian package, this package is not compiled under + mingw (windows gcc port). + * Close ITA bug. (closes: #112312) + + -- Baruch Even Sat, 22 Sep 2001 00:27:14 +0300 + +gcl (2.4.0-2) unstable; urgency=low + + * Change tclsh Build-Depends to tcl8.0 because apt is broken. (closes: #99261) + + -- JP Sugarbroad Wed, 30 May 2001 14:34:53 -0500 + +gcl (2.4.0-1) unstable; urgency=low + + * New upstream release + + -- JP Sugarbroad Sun, 13 May 2001 20:31:01 -0500 + +gcl (2.3.7+beta3-3) unstable; urgency=low + + * Move gcl-doc to section doc (closes: #78666) + + -- JP Sugarbroad Sun, 13 May 2001 20:26:28 -0500 + +gcl (2.3.7+beta3-2) unstable; urgency=low + + * Remove alpha from arch list + * Move tcl/tk from Depends to Suggests + + -- JP Sugarbroad Fri, 4 May 2001 16:24:11 -0500 + +gcl (2.3.7+beta3-1) unstable; urgency=low + + * New maintainer + * Repackaged with debhelper (closes: #42045, #86097, #91475, #91478) + * New upstream release (closes: #59577, #71096) + * Added sparc+alpha, removed m68k (closes: #87407) + + -- JP Sugarbroad Mon, 30 Apr 2001 19:07:49 -0500 + +gcl (2.2.1-6) unstable; urgency=low + + * Disable stripping of "saved_gcl" binary. (#45778) + + -- Steve Dunham Fri, 24 Sep 1999 14:39:15 -0400 + +gcl (2.2.1-5) unstable; urgency=low + + * Fix m68k build + + -- Steve Dunham Tue, 6 Jul 1999 09:45:09 -0400 + +gcl (2.2.1-4) unstable; urgency=low + + * Fix bug #31718 + + -- Steve Dunham Fri, 2 Jul 1999 11:11:12 -0400 + +gcl (2.2.1-3) unstable; urgency=low + + * Add m68k patches + + -- Steve Dunham Wed, 16 Dec 1998 14:25:46 -0500 + +gcl (2.2.1-2) unstable; urgency=low + + * Compile against libc6. New maintainer. + + -- Steve Dunham Wed, 5 Nov 1997 10:09:12 -0500 + +gcl (2.2.1-1) unstable; urgency=low + + * New upstream release; suggests tcl76, tk42. + * gcl-doc contains gcl-si and gcl-tk info pages. + * debian/rules: clean target removes temporary files from h and o + subdirectories (bug #5984). + + -- Karl Sackett Fri, 3 Jan 1997 10:16:40 -0600 + +gcl (2.2-5) unstable; urgency=low + + * Converted package to 2.1.1.0 standard. + * Stripped gcltkaux (bug #5074). + * gcl-si and gcl-tk info pages converted to HTML. + + -- Karl Sackett Tue, 5 Nov 1996 13:30:30 -0600 + +2.2-4 + * add-defs: patched locates for tk.tcl, init.tcl + * gcl-tk/tkAppInit.c: patched for tk4.1 support + * gcl-tk/tkMain.c: patched for tk4.1 support +2.2-3 + * Debian support files now partily architecture independent. + There are, however, no add-defs files except for 386-linux. + * Rebuilt package to correct corrupted upload problem. +2.2-2 + * Removed tk support from distribution. This was written to + use tk-3.6 and doesn't support tk-4.0 or tk-4.1. I am not aware + of any plans to upgrade the code. (Closes bug #2865) +2.2-1 + * Added Debian support files + * h/386-linux.defs: set OFLAG = -O2 + * h/386-linux.h: undid patch that swaped signal.h for sigcontext.h diff --git a/compat b/compat new file mode 100644 index 00000000..b1bd38b6 --- /dev/null +++ b/compat @@ -0,0 +1 @@ +13 diff --git a/control b/control new file mode 100644 index 00000000..e70945c4 --- /dev/null +++ b/control @@ -0,0 +1,39 @@ +Source: gcl +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl +Build-Depends: debhelper (>= 13), libreadline-dev, m4, tk8.6-dev, libgmp-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl +Standards-Version: 4.4.1 + +Package: gcl +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gcl-doc +Description: GNU Common Lisp compiler + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gcl-doc package. + +Package: gcl-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends} +Description: Documentation for GNU Common Lisp + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --git a/control. b/control. new file mode 100644 index 00000000..e70945c4 --- /dev/null +++ b/control. @@ -0,0 +1,39 @@ +Source: gcl +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl +Build-Depends: debhelper (>= 13), libreadline-dev, m4, tk8.6-dev, libgmp-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl +Standards-Version: 4.4.1 + +Package: gcl +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gcl-doc +Description: GNU Common Lisp compiler + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gcl-doc package. + +Package: gcl-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends} +Description: Documentation for GNU Common Lisp + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --git a/control.cvs b/control.cvs new file mode 100644 index 00000000..49527ff1 --- /dev/null +++ b/control.cvs @@ -0,0 +1,39 @@ +Source: gclcvs +Section: lisp +Priority: optional +Maintainer: Camm Maguire +Homepage: http://gnu.org/software/gcl +Build-Depends: debhelper (>= 13), libreadline-dev, m4, tk8.6-dev, libgmp-dev, libxmu-dev, libxaw7-dev, po-debconf, zlib1g-dev, tcl +Standards-Version: 4.4.1 + +Package: gclcvs +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, ${gcc}, debconf (>= 1.2.0), emacs24 | emacsen, ucf +Breaks: emacsen-common (<< 2.0.0) +Suggests: gclcvs-doc +Description: GNU Common Lisp compiler, CVS snapshot + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains the Lisp system itself. Documentation + is provided in the gclcvs-doc package. + +Package: gclcvs-doc +Section: doc +Architecture: all +Conflicts: gclinfo +Replaces: gclinfo +Depends: dpkg (>= 1.15.4) | install-info, ${misc:Depends} +Description: Documentation for GNU Common Lisp, CVS snapshot + GNU Common Lisp (GCL) is a Common Lisp compiler and interpreter + implemented in C, and complying mostly with the standard set + forth in the book "Common Lisp, the Language I". It attempts + to strike a useful middle ground in performance and portability + from its design around C. + . + This package contains Documentation in info format of both the + system internals, as well as the graphical interface currently + implemented in Tcl/Tk. diff --git a/copyright b/copyright new file mode 100644 index 00000000..c58a9836 --- /dev/null +++ b/copyright @@ -0,0 +1,65 @@ +This package was debianized by JP Sugarbroad on +Mon, 30 Apr 2001 19:07:49 -0500. + +It was downloaded from http://savannah.gnu.org/projects/gcl + +Upstream Author: Bill Schelter + +Copyright: + + This package is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This package is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this package; if not, write to the Free + Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA + 02110-1301, USA. + +On Debian GNU/Linux systems, the complete text of the GNU Lesser General +Public License can be found in `/usr/share/common-licenses/LGPL-2'. + +The source under xgcl-2 is + +Copyright (c) 1995 Gordon S. Novak Jr., Hiep Huu Nguyen, William F. Schelter, +and The University of Texas at Austin. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 1, or (at your option) +any later version. + +and + +;;********************************************************** +;;Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts, +;;and the Massachusetts Institute of Technology, Cambridge, Massachusetts. + +;; All Rights Reserved + +;;Permission to use, copy, modify, and distribute this software and its +;;documentation for any purpose and without fee is hereby granted, +;;provided that the above copyright notice appear in all copies and that +;;both that copyright notice and this permission notice appear in +;;supporting documentation, and that the names of Digital or MIT not be +;;used in advertising or publicity pertaining to distribution of the +;;software without specific, written prior permission. + +;;DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING +;;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL +;;DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR +;;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, +;;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, +;;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS +;;SOFTWARE. + +;;***************************************************************** + +On Debian GNU/Linux systems, the complete text of the GNU General +Public License can be found in `/usr/share/common-licenses/GPL-1'. diff --git a/gcl.lintian-overrides b/gcl.lintian-overrides new file mode 100644 index 00000000..35cdb234 --- /dev/null +++ b/gcl.lintian-overrides @@ -0,0 +1,9 @@ +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12-prof/unixport/saved_ansi_gcl +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12-prof/unixport/saved_gcl +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12/unixport/saved_ansi_gcl +gcl: binary-compiled-with-profiling-enabled usr/lib/gcl-2.6.12/unixport/saved_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12-prof/unixport/saved_ansi_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12-prof/unixport/saved_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12/unixport/saved_ansi_gcl +gcl: hardening-no-pie usr/lib/gcl-2.6.12/unixport/saved_gcl +gcl: emacsen-common-without-dh-elpa diff --git a/gcl.sh b/gcl.sh new file mode 100755 index 00000000..9ea80184 --- /dev/null +++ b/gcl.sh @@ -0,0 +1,28 @@ +#!/bin/sh + +EXT=@EXT@ +VERS=@VERS@ + +. /etc/default/gcl$EXT +if ! set | grep -q -w GCL_ANSI ; then GCL_ANSI=$DEFAULT_GCL_ANSI ; fi +if ! set | grep -q -w GCL_PROF ; then GCL_PROF=$DEFAULT_GCL_PROF ; fi + +if [ "$GCL_PROF" = "" ] ; then + DIR=/usr/lib/gcl-$VERS ; +else + DIR=/usr/lib/gcl-$VERS-prof ; +fi + +if [ "$GCL_ANSI" = "" ] ; then + EXE=saved_gcl; +else + EXE=saved_ansi_gcl; +fi +SYS=$DIR/unixport + +exec $SYS/$EXE -dir $SYS/ -libdir $DIR/ \ + -eval '(setq si::*allow-gzipped-file* t)' \ + -eval '(setq si::*tk-library* "/usr/lib/tk@TKVERS@")' \ + "$@" + +# other options: -load /tmp/foo.o -load jo.lsp -eval "(joe 3)" diff --git a/gcl.templates b/gcl.templates new file mode 100644 index 00000000..3bc069d7 --- /dev/null +++ b/gcl.templates @@ -0,0 +1,38 @@ +# These templates have been reviewed by the debian-l10n-english +# team +# +# If modifications/additions/rewording are needed, please ask +# debian-l10n-english@lists.debian.org for advice. +# +# Even minor modifications require translation updates and such +# changes should be coordinated with translators and reviewers. + +Template: gcl@EXT@/default_gcl_ansi +Type: boolean +_Description: Use the work-in-progress ANSI build by default? + GCL is in the process of providing an ANSI compliant image in addition to + its traditional CLtL1 image still in production use. + . + Please see the README.Debian file for a brief description of these terms. + Choosing this option will determine which image will be used by default + when executing 'gcl@EXT@'. + . + This setting may be overridden by setting the GCL_ANSI + environment variable to any non-empty string for the ANSI build, and to + the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The + currently enforced build flavor will be reported in the initial startup + banner. + +Template: gcl@EXT@/default_gcl_prof +Type: boolean +_Description: Use the profiling build by default? + GCL has optional support for profiling via gprof. + . + Please see the documentation for si::gprof-start and si::gprof-quit + for details. As this build is slower than builds without gprof + support, it is not recommended for final production use. + . + Set the GCL_PROF environment variable to the empty string for more + optimized builds, or any non-empty string for profiling support; e.g. + GCL_PROF=t gcl@EXT@. If profiling is enabled, this will be reported + in the initial startup banner. diff --git a/in.gcl-doc.README.Debian b/in.gcl-doc.README.Debian new file mode 100644 index 00000000..b8d01a66 --- /dev/null +++ b/in.gcl-doc.README.Debian @@ -0,0 +1,9 @@ +New in 2.6.2 +------------ + +The gcl.texi files and the resulting html, info, and pdf outputs have +been removed pending an enquiry into the copyright and license status +of the dpANS documents upon which they are presumably based. + + + -- Camm Maguire , Fri, 9 May 2014 19:08:59 +0000 diff --git a/in.gcl-doc.doc-base.si b/in.gcl-doc.doc-base.si new file mode 100644 index 00000000..faa0bc6a --- /dev/null +++ b/in.gcl-doc.doc-base.si @@ -0,0 +1,12 @@ +Document: gcl@EXT@-si-doc +Title: GNU Common Lisp Documentation -- System Internals +Author: W. Schelter +Abstract: Documentation on GCL-specific Lisp system functions +Section: Programming + +Format: PDF +Files: /usr/share/doc/gcl@EXT@-doc/gcl-si*.pdf.gz /usr/share/doc/gcl@EXT@-doc/gcl-si*.pdf.gz + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/gcl-si/index.html +Files: /usr/share/doc/gcl@EXT@-doc/gcl-si/*.html diff --git a/in.gcl-doc.doc-base.tk b/in.gcl-doc.doc-base.tk new file mode 100644 index 00000000..23d74ee7 --- /dev/null +++ b/in.gcl-doc.doc-base.tk @@ -0,0 +1,12 @@ +Document: gcl@EXT@-tk-doc +Title: GNU Common Lisp Tk Interface Documentation +Author: W. Schelter +Abstract: Documentation for Graphical Interface to GCL using TCL/Tk +Section: Programming + +Format: PDF +Files: /usr/share/doc/gcl@EXT@-doc/gcl-tk*.pdf.gz /usr/share/doc/gcl@EXT@-doc/gcl-tk*.pdf.gz + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/gcl-tk/index.html +Files: /usr/share/doc/gcl@EXT@-doc/gcl-tk/*.html diff --git a/in.gcl-doc.doc-base.xgcl b/in.gcl-doc.doc-base.xgcl new file mode 100644 index 00000000..a78b27be --- /dev/null +++ b/in.gcl-doc.doc-base.xgcl @@ -0,0 +1,15 @@ +Document: gcl@EXT@-xgcl-doc +Title: GNU Common Lisp Documentation -- System Internals +Author: W. Schelter +Abstract: Documentation on GCL-specific Lisp system functions +Section: Programming + +Format: Text +Files: /usr/share/doc/gcl@EXT@-doc/dwdoc.tex.gz + +Format: PDF +Files: /usr/share/doc/gcl@EXT@-doc/dwdoc.pdf.gz + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/dwdoc/dwdoc1.html +Files: /usr/share/doc/gcl@EXT@-doc/dwdoc/*.html diff --git a/in.gcl-doc.docs b/in.gcl-doc.docs new file mode 100644 index 00000000..2757ff23 --- /dev/null +++ b/in.gcl-doc.docs @@ -0,0 +1,3 @@ +faq +readme +readme.xgcl diff --git a/in.gcl-doc.info b/in.gcl-doc.info new file mode 100644 index 00000000..cedf3f17 --- /dev/null +++ b/in.gcl-doc.info @@ -0,0 +1,4 @@ +debian/tmp/usr/share/info/gcl@EXT@-si.info +debian/tmp/usr/share/info/gcl@EXT@-tk.info +debian/tmp/usr/share/info/gcl@EXT@-tk.info-1 +debian/tmp/usr/share/info/gcl@EXT@-tk.info-2 diff --git a/in.gcl-doc.install b/in.gcl-doc.install new file mode 100644 index 00000000..8e31d17d --- /dev/null +++ b/in.gcl-doc.install @@ -0,0 +1 @@ +debian/tmp/usr/share/doc/gcl@EXT@-doc diff --git a/in.gcl.config b/in.gcl.config new file mode 100644 index 00000000..0d960b11 --- /dev/null +++ b/in.gcl.config @@ -0,0 +1,19 @@ +#!/bin/sh +CONFIGFILE=/etc/default/gcl@EXT@ +set -e +. /usr/share/debconf/confmodule + +# Load config file, if it exists. +if [ -e $CONFIGFILE ]; then + . $CONFIGFILE || true + + # Store values from config file into + # debconf db. + db_set gcl@EXT@/default_gcl_ansi $DEFAULT_GCL_ANSI + db_set gcl@EXT@/default_gcl_prof $DEFAULT_GCL_PROF +fi + +# Ask questions. +db_input medium gcl@EXT@/default_gcl_ansi || true +db_input medium gcl@EXT@/default_gcl_prof || true +db_go || true diff --git a/in.gcl.docs b/in.gcl.docs new file mode 100644 index 00000000..b50c9454 --- /dev/null +++ b/in.gcl.docs @@ -0,0 +1,2 @@ +ansi-tests/test_results +RELEASE-2.6.2.html diff --git a/in.gcl.emacsen-compat b/in.gcl.emacsen-compat new file mode 100644 index 00000000..573541ac --- /dev/null +++ b/in.gcl.emacsen-compat @@ -0,0 +1 @@ +0 diff --git a/in.gcl.emacsen-install b/in.gcl.emacsen-install new file mode 100644 index 00000000..ed972091 --- /dev/null +++ b/in.gcl.emacsen-install @@ -0,0 +1,46 @@ +#! /bin/sh -e +# /usr/lib/emacsen-common/packages/install/#PACKAGE# + +# Written by Jim Van Zandt , borrowing heavily +# from the install scripts for gettext by Santiago Vila +# and octave by Dirk Eddelbuettel . + +FLAVOR=$1 +PACKAGE=gcl@EXT@ + +if [ ${FLAVOR} = emacs ]; then exit 0; fi + +echo install/${PACKAGE}: Handling install for emacsen flavor ${FLAVOR} + +#FLAVORTEST=`echo $FLAVOR | cut -c-6` +#if [ ${FLAVORTEST} = xemacs ] ; then +# SITEFLAG="-no-site-file" +#else +# SITEFLAG="--no-site-file" +#fi +FLAGS="${SITEFLAG} -q -batch -l path.el -f batch-byte-compile" + +ELDIR=/usr/share/emacs/site-lisp/${PACKAGE} +ELCDIR=/usr/share/${FLAVOR}/site-lisp/${PACKAGE} + +# Install-info-altdir does not actually exist. +# Maybe somebody will write it. +if test -x /usr/sbin/install-info-altdir; then + echo install/${PACKAGE}: install Info links for ${FLAVOR} + install-info-altdir --quiet --section "" "" --dirname=${FLAVOR} /usr/info/${PACKAGE}.info.gz +fi + +install -m 755 -d ${ELCDIR} +cd ${ELDIR} +FILES=`echo *.el` +cp ${FILES} ${ELCDIR} +cd ${ELCDIR} + +cat << EOF > path.el +(setq load-path (cons "." load-path) byte-compile-warnings nil) +EOF +${FLAVOR} ${FLAGS} ${FILES} +rm -f *.el path.el + +exit 0 + diff --git a/in.gcl.emacsen-remove b/in.gcl.emacsen-remove new file mode 100644 index 00000000..699eca18 --- /dev/null +++ b/in.gcl.emacsen-remove @@ -0,0 +1,15 @@ +#!/bin/sh -e +# /usr/lib/emacsen-common/packages/remove/#PACKAGE# + +FLAVOR=$1 +PACKAGE=gcl@EXT@ + +if [ ${FLAVOR} != emacs ]; then + if test -x /usr/sbin/install-info-altdir; then + echo remove/${PACKAGE}: removing Info links for ${FLAVOR} + install-info-altdir --quiet --remove --dirname=${FLAVOR} /usr/info/#PACKAGE#.info.gz + fi + + echo remove/${PACKAGE}: purging byte-compiled files for ${FLAVOR} + rm -rf /usr/share/${FLAVOR}/site-lisp/${PACKAGE} +fi diff --git a/in.gcl.emacsen-startup b/in.gcl.emacsen-startup new file mode 100644 index 00000000..e64d9a80 --- /dev/null +++ b/in.gcl.emacsen-startup @@ -0,0 +1,19 @@ +;; -*-emacs-lisp-*- +;; +;; Emacs startup file for the Debian GNU/Linux #PACKAGE# package +;; +;; Originally contributed by Nils Naumann +;; Modified by Dirk Eddelbuettel +;; Adapted for dh-make by Jim Van Zandt + +;; The #PACKAGE# package follows the Debian/GNU Linux 'emacsen' policy and +;; byte-compiles its elisp files for each 'emacs flavor' (emacs19, +;; xemacs19, emacs20, xemacs20...). The compiled code is then +;; installed in a subdirectory of the respective site-lisp directory. +;; We have to add this to the load-path: +(setq load-path (cons (concat "/usr/share/" + (symbol-name debian-emacs-flavor) + "/site-lisp/gcl@EXT@") load-path)) + +(autoload 'run@EXT@ "gcl@EXT@" "" t) +(autoload 'dbl@EXT@ "dbl@EXT@" "" t) diff --git a/in.gcl.install b/in.gcl.install new file mode 100644 index 00000000..731600b6 --- /dev/null +++ b/in.gcl.install @@ -0,0 +1,3 @@ +debian/tmp/usr/lib +debian/tmp/usr/bin +debian/tmp/usr/share/emacs diff --git a/in.gcl.manpages b/in.gcl.manpages new file mode 100644 index 00000000..0b22534b --- /dev/null +++ b/in.gcl.manpages @@ -0,0 +1 @@ +debian/tmp/usr/share/man/man1/gcl@EXT@.1 diff --git a/in.gcl.postinst b/in.gcl.postinst new file mode 100644 index 00000000..c7875887 --- /dev/null +++ b/in.gcl.postinst @@ -0,0 +1,40 @@ +#!/bin/sh +case "$1" in + configure) + + CONFIGFILE=$(tempfile -m 644) + set -e + . /usr/share/debconf/confmodule + + if [ "$1" = "configure" ] || [ "$1" = "reconfigure" ] ; then + + db_get gcl@EXT@/default_gcl_ansi + + if [ "$RET" = "true" ] ; then + DEFAULT_GCL_ANSI=t + else + DEFAULT_GCL_ANSI= + fi + + db_get gcl@EXT@/default_gcl_prof + + if [ "$RET" = "true" ] ; then + DEFAULT_GCL_PROF=y + else + DEFAULT_GCL_PROF= + fi + + echo "DEFAULT_GCL_ANSI=$DEFAULT_GCL_ANSI" >> $CONFIGFILE + echo "DEFAULT_GCL_PROF=$DEFAULT_GCL_PROF" >> $CONFIGFILE + + fi + + ucf --debconf-ok $CONFIGFILE /etc/default/gcl@EXT@ + ucfr gcl@EXT@ /etc/default/gcl@EXT@ + +# chmod 644 /etc/default/gcl@EXT@ + +esac + +#DEBHELPER# + diff --git a/in.gcl.postrm b/in.gcl.postrm new file mode 100644 index 00000000..5360f7dc --- /dev/null +++ b/in.gcl.postrm @@ -0,0 +1,22 @@ +#!/bin/sh + +set -e + +case "$1" in + purge) + for ext in '~' '%' .bak .ucf-new .ucf-old .ucf-dist; do + rm -f /etc/default/gcl@EXT@$ext + done + + rm -f /etc/default/gcl@EXT@ + + if which ucf >/dev/null; then + ucf --purge /etc/default/gcl@EXT@ + fi + if which ucfr >/dev/null; then + ucfr --purge gcl@EXT@ /etc/default/gcl@EXT@ + fi + ;; +esac + +#DEBHELPER# diff --git a/old.in.gcl-doc.doc-base.main b/old.in.gcl-doc.doc-base.main new file mode 100644 index 00000000..2d6f3d12 --- /dev/null +++ b/old.in.gcl-doc.doc-base.main @@ -0,0 +1,12 @@ +Document: gcl@EXT@-doc +Title: GNU Common Lisp Documentation +Author: W. Schelter +Abstract: A Common Lisp compiler and interpreter based on C +Section: Apps/Programming + +Format: DVI +Files: /usr/share/doc/gcl@EXT@-doc/gcl.dvi.gz /usr/share/doc/gcl@EXT@-doc/gcl.dvi + +Format: HTML +Index: /usr/share/doc/gcl@EXT@-doc/gcl/index.html +Files: /usr/share/doc/gcl@EXT@-doc/gcl/*.html diff --git a/patches/Version_2_6_13pre1 b/patches/Version_2_6_13pre1 new file mode 100644 index 00000000..2599262b --- /dev/null +++ b/patches/Version_2_6_13pre1 @@ -0,0 +1,13167 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-2) unstable; urgency=medium + . + * Version_2_6_13pre1 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/clcs/package.lisp ++++ gcl-2.6.12/clcs/package.lisp +@@ -20,3 +20,4 @@ + (defvar *this-package* (find-package :conditions)) + + ++(import 'si::(clines defentry defcfun object void int double)) +--- gcl-2.6.12.orig/clcs/sys-proclaim.lisp ++++ gcl-2.6.12/clcs/sys-proclaim.lisp +@@ -1,45 +1,46 @@ + +-(IN-PACKAGE "CONDITIONS") +-(PROCLAIM +- '(FTYPE (FUNCTION (T) T) CONDITION-CLASS-P IS-WARNING CONDITIONP +- IS-CONDITION ESCAPE-SPECIAL-CASES-REPLACE +- SIMPLE-CONDITION-CLASS-P INTERNAL-SIMPLE-CONDITION-CLASS-P)) +-(PROCLAIM '(FTYPE (FUNCTION (*) *) CLCS-COMPILE)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T) T) ASSERT-REPORT SYMCAT COERCE-TO-FN +- SLOT-SYM)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T *) *) CLCS-LOAD CLCS-OPEN CLCS-COMPILE-FILE +- MAKE-CONDITION)) +-(PROCLAIM '(FTYPE (FUNCTION (T) (*)) SIMPLE-ASSERTION-FAILURE)) +-(PROCLAIM '(FTYPE (FUNCTION (T T T) T) ACCUMULATE-CASES)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T) T) +- |(PCL::FAST-METHOD PRINT-OBJECT (CONDITION T))|)) +-(PROCLAIM '(FTYPE (FUNCTION (T T) *) ASSERT-PROMPT)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T) *) +- |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-WARNING T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-ERROR T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| +- COERCE-TO-CONDITION +- |(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))| +- |(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))|)) +-(PROCLAIM +- '(FTYPE (FUNCTION NIL T) REVERT-CLCS-SYMBOLS INSTALL-CLCS-SYMBOLS +- READ-EVALUATED-FORM)) +-(MAPC (LAMBDA (COMPILER::X) +- (SETF (GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) T)) +- '(INSTALL-SYMBOL REVERT-SYMBOL)) +\ No newline at end of file ++(COMMON-LISP::IN-PACKAGE "CONDITIONS") ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ CONDITIONS::IS-WARNING CONDITIONS::DEFAULT-REPORT ++ CONDITIONS::IS-CONDITION CONDITIONS::CONDITIONP)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CONDITION T))| ++ CONDITIONS::|(PCL::FAST-METHOD MAKE-LOAD-FORM (CONDITION))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMMON-LISP::MAKE-CONDITION)) +\ No newline at end of file +--- gcl-2.6.12.orig/cmpnew/gcl_cmpbind.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpbind.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'bds-bind 'set-bds-bind 'set-loc) + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpblock.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpblock.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'block 'c1block 'c1special) + (si:putprop 'block 'c2block 'c2) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpcall.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpcall.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (defvar *ifuncall* nil) + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpcatch.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpcatch.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'catch 'c1catch 'c1special) + (si:putprop 'catch 'c2catch 'c2) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (defvar *safe-compile* nil) + (defvar *compiler-check-args* nil) +@@ -337,7 +337,7 @@ + readtable sequence short-float simple-array simple-bit-vector + simple-string simple-vector single-float standard-char stream string + dynamic-extent :dynamic-extent +- string-char symbol t vector signed-byte unsigned-byte) ++ symbol t vector signed-byte unsigned-byte) + (proclaim-var (car decl) (cdr decl))) + (otherwise + (unless (member (car decl) *alien-declarations*) +@@ -366,6 +366,12 @@ + (t + (warn "The variable name ~s is not a symbol." var))))) + ++(defun mexpand-deftype (tp &aux (l (listp tp))(i (when l (cdr tp)))(tp (if l (car tp) tp))) ++ (when (symbolp tp) ++ (let ((fn (get tp 'si::deftype-definition))) ++ (when fn ++ (apply fn i))))) ++ + (defun c1body (body doc-p &aux (ss nil) (is nil) (ts nil) (others nil) + doc form) + (loop +@@ -383,10 +389,8 @@ + ;;; 20040320 CM + (cmpck (not (consp decl)) + "The declaration ~s is illegal." decl) +- (let* ((dtype (car decl))) +-;; Can process user deftypes here in the future -- 20040318 CM +-;; (dft (and (symbolp dtype) (get dtype 'si::deftype-definition))) +-;; (dtype (or (and dft (funcall dft)) dtype))) ++ (let* ((dtype (car decl)) ++ (dtype (or (mexpand-deftype dtype) dtype))) + (if (consp dtype) + (let ((stype (car dtype))) + (cmpck (or (not (symbolp stype)) (cdddr dtype)) "The declaration ~s is illegal." decl) +@@ -449,7 +453,7 @@ + integer keyword list long-float nil null number package pathname + random-state ratio rational readtable sequence simple-array + simple-bit-vector simple-string simple-base-string simple-vector single-float +- standard-char stream string string-char symbol t vector ++ standard-char stream string symbol t vector + signed-byte unsigned-byte) + (let ((type (type-filter stype))) + (when type +@@ -667,7 +671,7 @@ + readtable sequence short-float simple-array simple-bit-vector + simple-string simple-vector single-float standard-char stream string + dynamic-extent :dynamic-extent +- string-char symbol t vector signed-byte unsigned-byte) ++ symbol t vector signed-byte unsigned-byte) + (let ((type (type-filter (car decl)))) + (dolist** (var (cdr decl) t) + (if (symbolp var) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpeval.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpeval.lsp +@@ -23,9 +23,9 @@ + + (export '(si::define-compiler-macro + si::undef-compiler-macro +- si::define-inline-function) 'system) ++ si::define-inline-function) :system) + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'progn 'c1progn 'c1special) + (si:putprop 'progn 'c2progn 'c2) +@@ -180,9 +180,8 @@ + + + (defun result-type-from-args(f args &aux tem) +- (when (and (setq tem (get f 'return-type)) +- (not (eq tem '*)) +- (not (consp tem))) ++ (when (if (setq tem (get f 'return-type)) ++ (and (not (eq tem '*)) (not (consp tem))) t) + (dolist (v '(inline-always inline-unsafe)) + (dolist (w (get f v)) + (fix-opt w) +@@ -486,19 +485,22 @@ + + (defun c1structure-ref1 (form name index &aux (info (make-info))) + ;;; Explicitly called from c1expr and c1structure-ref. +- (declare (special *aet-types*)) + (cond (*safe-compile* (c1expr `(si::structure-ref ,form ',name ,index))) +- (t +- (let* ((sd (get name 'si::s-data)) +- (aet-type (aref (si::s-data-raw sd) index)) +- ) +- (setf (info-type info) (type-filter (aref *aet-types* aet-type))) +- (list 'structure-ref info +- (c1expr* form info) +- (add-symbol name) +- index sd) +- +- )))) ++ ((let* ((sd (get name 'si::s-data)) ++ (aet-type (aref (si::s-data-raw sd) index)) ++ (sym (find-symbol (si::string-concatenate ++ (or (si::s-data-conc-name sd) "") ++ (car (nth index (si::s-data-slot-descriptions sd)))))) ++ (tp (if sym (get-return-type sym) '*)) ++ (tp (type-filter (type-and tp (aref *aet-types* aet-type))))) ++ ++ (setf (info-type info) (if (and (eq name 'si::s-data) (= index 2));;FIXME -- this belongs somewhere else. CM 20050106 ++ '(vector unsigned-char) ++ tp)) ++ (list 'structure-ref info ++ (c1expr* form info) ++ (add-symbol name) ++ index sd))))) + + (defun coerce-loc-structure-ref (arg type-wanted &aux (form (cdr arg))) + (let* ((sd (fourth form)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpflet.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpflet.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'flet 'c1flet 'c1special) + (si:putprop 'flet 'c2flet 'c2) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'princ 'c1princ 'c1) + (si:putprop 'princ 'c2princ 'c2) +@@ -565,7 +565,7 @@ + (equal (third type) '(*))))) + (setq tem (si::best-array-element-type + (second type))) +- (cond ((eq tem 'string-char) `(stringp ,x)) ++ (cond ((eq tem 'character) `(stringp ,x)) + ((eq tem 'bit) `(bit-vector-p ,x)) + ((setq tem (position tem *aet-types*)) + `(the boolean (vector-type ,x ,tem))))) +@@ -803,7 +803,7 @@ + + + (defvar *aet-types* +- #(T STRING-CHAR SIGNED-CHAR FIXNUM SHORT-FLOAT LONG-FLOAT ++ #(T CHARACTER SIGNED-CHAR FIXNUM SHORT-FLOAT LONG-FLOAT + SIGNED-CHAR + UNSIGNED-CHAR SIGNED-SHORT UNSIGNED-SHORT)) + +@@ -811,7 +811,7 @@ + (defun aet-c-type (type) + (ecase type + ((t) "object") +- ((string-char signed-char) "char") ++ ((character signed-char) "char") + (fixnum "fixnum") + (unsigned-char "unsigned char") + (unsigned-short "unsigned short") +--- gcl-2.6.12.orig/cmpnew/gcl_cmpif.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpif.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'if 'c1if 'c1special) + (si:putprop 'if 'c2if 'c2) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpinline.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpinline.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + ;;; Pass 1 generates the internal form + ;;; ( id info-object . rest ) +--- gcl-2.6.12.orig/cmpnew/gcl_cmplabel.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmplabel.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (defvar *last-label* 0) + (defvar *exit*) +--- gcl-2.6.12.orig/cmpnew/gcl_cmplam.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmplam.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + ;;; During Pass1, a lambda-list + ;;; +--- gcl-2.6.12.orig/cmpnew/gcl_cmplet.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmplet.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + (eval-when (compile) + (or (fboundp 'write-block-open) (load "cmplet.lsp"))) + +--- gcl-2.6.12.orig/cmpnew/gcl_cmploc.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmploc.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (defvar *value-to-go*) + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -24,7 +24,7 @@ + ;;; ***************** + + +-(in-package 'compiler) ++(in-package :compiler) + + + (export '(*compile-print* *compile-verbose*)) +@@ -49,7 +49,11 @@ + (defvar *cmpinclude* "\"cmpinclude.h\"") + ;;If the following is a string, then it is inserted instead of + ;; the include file cmpinclude.h, EXCEPT for system-p calls. +-(defvar *cmpinclude-string* t) ++(defvar *cmpinclude-string* ++ (si::file-to-string ++ (namestring ++ (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :parent "h")) ++ :name "cmpinclude" :type "h")))) + + + ;; Let the user write dump c-file etc to /dev/null. +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmap.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmap.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'mapcar 'c1mapcar 'c1) + (si:putprop 'maplist 'c1maplist 'c1) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'multiple-value-call 'c1multiple-value-call 'c1special) + (si:putprop 'multiple-value-call 'c2multiple-value-call 'c2) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpopt.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpopt.lsp +@@ -1,4 +1,4 @@ +-(in-package 'compiler) ++(in-package :compiler) + + ;; The optimizers have been redone to allow more flags + ;; The old style optimizations correspond to the first 2 +@@ -136,8 +136,11 @@ + (get 'system:aset 'inline-unsafe)) + (push '(((array t) fixnum t) t #.(flags set)"(#0)->v.v_self[#1]= (#2)") + (get 'system:aset 'inline-unsafe)) +-(push '(((array string-char) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)") ++(push '(((array character) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)") + (get 'system:aset 'inline-unsafe)) ++(push '(((array bit) fixnum fixnum) fixnum #.(flags rfa) ++ "({object _o=(#0);fixnum _i=(#1)+_o->bv.bv_offset;char _c=1<bv.bv_self+(_i>>3);bool _b=(#2);if (_b) *_d|=_c; else *_d&=~_c;_b;})") ++ (get 'si::aset 'inline-unsafe)) + (push '(((array fixnum) fixnum fixnum) fixnum #.(flags set rfa)"(#0)->fixa.fixa_self[#1]= (#2)") + (get 'system:aset 'inline-unsafe)) + (push '(((array signed-short) fixnum fixnum) fixnum #.(flags rfa set)"((short *)(#0)->ust.ust_self)[#1]=(#2)") +@@ -159,7 +162,7 @@ + (push '(((array t) fixnum fixnum t) t #.(flags set) + "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)") + (get 'system:aset 'inline-unsafe)) +-(push '(((array string-char) fixnum fixnum character) character ++(push '(((array character) fixnum fixnum character) character + #.(flags rfa set) + "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)") + (get 'system:aset 'inline-unsafe)) +@@ -433,7 +436,9 @@ + (get 'aref 'inline-unsafe)) + (push '(((array t) fixnum) t #.(flags)"(#0)->v.v_self[#1]") + (get 'aref 'inline-unsafe)) +-(push '(((array string-char) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]") ++(push '(((array character) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]") ++ (get 'aref 'inline-unsafe)) ++(push '(((array bit) fixnum) fixnum #.(flags rfa)"({object _o=(#0);fixnum _i=(#1)+(_o)->bv.bv_offset;(_o->bv.bv_self[_i>>3]>>BIT_ENDIAN(_i&0x7))&0x1;})") + (get 'aref 'inline-unsafe)) + (push '(((array fixnum) fixnum) fixnum #.(flags rfa)"(#0)->fixa.fixa_self[#1]") + (get 'aref 'inline-unsafe)) +@@ -456,7 +461,7 @@ + (push '(((array t) fixnum fixnum) t #.(flags ) + "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]") + (get 'aref 'inline-unsafe)) +-(push '(((array string-char) fixnum fixnum) character #.(flags rfa) ++(push '(((array character) fixnum fixnum) character #.(flags rfa) + "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]") + (get 'aref 'inline-unsafe)) + (push '(((array fixnum) fixnum fixnum) fixnum #.(flags rfa) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpspecial.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpspecial.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'quote 'c1quote 'c1special) + (si:putprop 'function 'c1function 'c1special) +--- gcl-2.6.12.orig/cmpnew/gcl_cmptag.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptag.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + (import 'si::switch) + (import 'si::switch-finish) + +--- gcl-2.6.12.orig/cmpnew/gcl_cmptest.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptest.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (defun self-compile () + (with-open-file (log "lsplog" :direction :output) +--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (defvar *objects* (make-hash-table :test 'eq)) + ;(defvar *objects* nil) +@@ -572,7 +572,7 @@ + (defun make-inline-string (cfun args fname) + (if (null args) + (format nil "~d()" (c-function-name "LI" cfun fname)) +- (let ((o (make-array 100 :element-type 'string-char :fill-pointer 0 ++ (let ((o (make-array 100 :element-type 'character :fill-pointer 0 + :adjustable t ))) + (format o "~d(" (c-function-name "LI" cfun fname)) + (do ((l args (cdr l)) +@@ -696,7 +696,7 @@ + ))) + + (defun si::add-debug (fname x) +- (si::putprop fname x 'si::debug)) ++ (si::putprop fname x 'si::debugger)) + + (defun t3init-fun (fname cfun lambda-expr doc) + +@@ -1237,10 +1237,10 @@ + (si::fixnump (cdr (var-ref va)))) + (setf (nth (cdr (var-ref va)) locals) + (var-name va)))) +- (setf (get fname 'si::debug) locals) +- (let ((locals (get fname 'si::debug))) ++ (setf (get fname 'si::debugger) locals) ++ (let ((locals (get fname 'si::debugger))) + (if (and locals (or (cdr locals) (not (null (car locals))))) +- (add-init `(si::debug ',fname ',locals) ) ++ (add-init `(debug ',fname ',locals) ) + )) + )))) + +@@ -1406,7 +1406,7 @@ + ((and (consp form) + (symbolp (car form)) + (or (eq (car form) 'setq) +- (not (special-form-p (car form)))) ++ (not (special-operator-p (car form)))) + (do ((v (cdr form) (and (consp v) (cdr v))) + (i 1 (the fixnum (+ 1 i)))) + ((or (>= i 1000) +@@ -1457,7 +1457,7 @@ + (setf (get 'si::define-structure 't1) 't1define-structure) + + (defun t1define-structure (args) +- (maybe-eval t `(si::define-structure ,@args ,(not (maybe-eval nil nil)))) ++ (maybe-eval t `(si::define-structure ,@(copy-tree args) ,(not (maybe-eval nil nil))));FIXME + (t1ordinary (cons 'si::define-structure args))) + + +@@ -1484,7 +1484,7 @@ + (cond ((stringp s) (push s body)) + ((consp s) + (cond ((symbolp (car s)) +- (cmpck (special-form-p (car s)) ++ (cmpck (special-operator-p (car s)) + "Special form ~s is not allowed in defCfun." (car s)) + (push (list (cons (car s) (parse-cvspecs (cdr s)))) body)) + ((and (consp (car s)) (symbolp (caar s)) +@@ -1493,7 +1493,7 @@ + (not (endp (cddar s))) + (endp (cdr s)) + (not (endp (cddr s)))) +- (special-form-p (caar s))))) ++ (special-operator-p (caar s))))) + (push (cons (cons (caar s) + (if (eq (caar s) 'quote) + (list (add-object (cadar s))) +--- gcl-2.6.12.orig/cmpnew/gcl_cmptype.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptype.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + ;;; CL-TYPE is any valid type specification of Common Lisp. + ;;; +@@ -51,7 +51,7 @@ + (let ((type (type-of thing))) + (case type + ((fixnum short-float long-float) type) +- ((string-char standard-char character) 'character) ++ ((standard-char character) 'character) + ((string bit-vector) type) + (vector (list 'vector (array-element-type thing))) + (array (list 'array (array-element-type thing))) +@@ -82,7 +82,7 @@ + (and (consp (caddr type)) + (= (length (caddr type)) 1)))) + (case element-type +- (string-char 'string) ++ (character 'string) + (bit 'bit-vector) + (t (list 'vector element-type)))) + (t (list 'array element-type)))) +@@ -109,8 +109,8 @@ + ((subtypep type '(vector long-float)) + '(vector long-float)) + ((subtypep type '(array t)) '(array t)) +- ((subtypep type '(array string-char)) +- '(array string-char)) ++ ((subtypep type '(array character)) ++ '(array character)) + ((subtypep type '(array bit)) '(array bit)) + ((subtypep type '(array fixnum)) '(array fixnum)) + ((subtypep type '(array short-float)) +@@ -142,11 +142,13 @@ + ((eq type1 t) type2) + ((eq type2 'object) type1) + ((eq type2 t) type1) +- ((consp type1) ++ ((subtypep type2 type1) type2) ++ ((subtypep type1 type2) type1) ++ ((consp type1) + (case (car type1) + (array + (case (cadr type1) +- (string-char (if (eq type2 'string) type2 nil)) ++ (character (if (eq type2 'string) type2 nil)) + (bit (if (eq type2 'bit-vector) type2 nil)) + (t (if (and (consp type2) + (eq (car type2) 'vector) +@@ -160,7 +162,7 @@ + (t (case type1 + (string + (if (and (consp type2) (eq (car type2) 'array) +- (eq (cadr type2) 'string-char)) ++ (eq (cadr type2) 'character)) + type1 nil)) + (bit-vector + (if (and (consp type2) (eq (car type2) 'array) +--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (export '(*suppress-compiler-warnings* + *suppress-compiler-notes* +@@ -204,7 +204,7 @@ + (do-macro-expansion '(macroexpand-1) form) + form)) + +-(defun cmp-expand-macro (fd fname args &aux env (form (cons fname args))) ++(defun cmp-expand-macro (fd fname args &aux (form (cons fname args))) + (if (macro-def-p form) + (do-macro-expansion `(funcall *macroexpand-hook* ',fd) form) + form)) +@@ -214,7 +214,7 @@ + (defun cmp-toplevel-eval (form) + (let* ((si::*ihs-base* si::*ihs-top*) + (si::*ihs-top* (1- (si::ihs-top))) +- (*break-enable* *compiler-break-enable*) ++ (si::*break-enable* *compiler-break-enable*) + (si::*break-hidden-packages* + (cons (find-package 'compiler) + si::*break-hidden-packages*))) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpvar.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpvar.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'var 'c2var 'c2) + (si:putprop 'location 'c2location 'c2) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpvs.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpvs.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (si:putprop 'vs 'set-vs 'set-loc) + (si:putprop 'vs 'wt-vs 'wt-loc) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp +@@ -19,7 +19,7 @@ + ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + +-(in-package 'compiler) ++(in-package :compiler) + + (eval-when (compile eval) + (require 'FASDMACROS "../cmpnew/gcl_fasdmacros.lsp") +--- gcl-2.6.12.orig/cmpnew/gcl_collectfn.lsp ++++ gcl-2.6.12/cmpnew/gcl_collectfn.lsp +@@ -13,7 +13,7 @@ + ;; Additionally cross reference information about functions in the system is + ;; collected. + +-(in-package 'compiler) ++(in-package :compiler) + (import 'sloop::sloop) + + (defstruct fn +--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp ++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp +@@ -3,7 +3,7 @@ + ;; and making the arglists correct if they have optional args. + ;; + +-(in-package 'compiler) ++(in-package :compiler) + + (DEFSYSFUN 'GENSYM "Lgensym" '(*) 'T NIL NIL) + (DEFSYSFUN 'SUBSEQ "Lsubseq" '(T T *) 'T NIL NIL) +@@ -129,7 +129,7 @@ + (DEFSYSFUN 'STRING-NOT-GREATERP "Lstring_not_greaterp" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'STRING> "Lstring_g" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'FINISH-OUTPUT "Lfinish_output" '(*) 'T NIL NIL) +-(DEFSYSFUN 'SPECIAL-FORM-P "Lspecial_form_p" '(T) 'T NIL T) ++(DEFSYSFUN 'SPECIAL-OPERATOR-P "Lspecial_operator_p" '(T) 'T NIL T) + (DEFSYSFUN 'STRINGP "Lstringp" '(T) 'T NIL T) + (DEFSYSFUN 'GET-INTERNAL-RUN-TIME "Lget_internal_run_time" 'NIL 'T NIL + NIL) +@@ -303,7 +303,7 @@ + (DEFSYSFUN '= "Lall_the_same" '(T *) 'T NIL T) + (DEFSYSFUN 'GENTEMP "Lgentemp" '(*) 'T NIL NIL) + (DEFSYSFUN 'RENAME-PACKAGE "Lrename_package" '(T T *) 'T NIL NIL) +-(DEFSYSFUN 'COMMONP "Lcommonp" '(T) 'T NIL T) ++(DEFSYSFUN 'COMMONP "siLcommonp" '(T) 'T NIL T) + (DEFSYSFUN 'NUMBERP "Lnumberp" '(T) 'T NIL T) + (DEFSYSFUN 'COPY-READTABLE "Lcopy_readtable" '(*) 'T NIL NIL) + (DEFSYSFUN 'RANDOM-STATE-P "Lrandom_state_p" '(T) 'T NIL T) +@@ -365,7 +365,7 @@ + (DEFSYSFUN 'ASSOC-IF "Lassoc_if" '(T T) 'T NIL NIL) + (DEFSYSFUN 'GET-PROPERTIES "Lget_properties" '(T T) '* NIL NIL) + (DEFSYSFUN 'STRING<= "Lstring_le" '(T T *) 'T NIL NIL) +-(DEFSYSFUN 'EVALHOOK "Levalhook" '(T T T *) 'T NIL NIL) ++(DEFSYSFUN 'EVALHOOK "siLevalhook" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'FILE-WRITE-DATE "Lfile_write_date" '(T) 'T NIL NIL) + (DEFSYSFUN 'LOGCOUNT "Llogcount" '(T) 'T NIL NIL) + (DEFSYSFUN 'MERGE-PATHNAMES "Lmerge_pathnames" '(T *) 'T NIL NIL) +--- gcl-2.6.12.orig/cmpnew/gcl_make_ufun.lsp ++++ gcl-2.6.12/cmpnew/gcl_make_ufun.lsp +@@ -20,13 +20,13 @@ + + + +-(in-package 'compiler) ++(in-package :compiler) + + (defvar gazonk (make-package 'symbol-table :use nil)) + (defvar eof (cons nil nil)) + (defvar *Ufun-out*) + +-(defvar *str* (make-array 128 :element-type 'string-char :fill-pointer 0)) ++(defvar *str* (make-array 128 :element-type 'character :fill-pointer 0)) + + (defun make-Ufun (in-files &key (out-file "Ufun_list.lsp")) + (with-open-file (*Ufun-out* out-file :direction :output) +--- gcl-2.6.12.orig/cmpnew/gcl_nocmpinc.lsp ++++ gcl-2.6.12/cmpnew/gcl_nocmpinc.lsp +@@ -1,6 +1,6 @@ + + +-(in-package 'compiler) ++(in-package :compiler) + + (defvar *cmpinclude-string* nil) + +@@ -20,4 +20,4 @@ + + + +- +\ No newline at end of file ++ +--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp ++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp +@@ -1,168 +1,377 @@ + +-(IN-PACKAGE "COMPILER") +-(MAPC (LAMBDA (X) (SETF (GET X 'PROCLAIMED-CLOSURE) T)) +- '(CMP-TMP-MACRO COMPILE DISASSEMBLE CMP-ANON)) +-(PROCLAIM '(FTYPE (FUNCTION (STRING *) T) TS)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) T) VAR-REP-LOC C1FUNOB C1STRUCTURE-REF +- T1PROGN GET-RETURN-TYPE ADD-REG1 C1VAR C1ECASE +- C1SHARP-COMMA C1ASH LTVP CTOP-WRITE C2FUNCTION +- DECLARATION-TYPE C1TERPRI C1FUNCALL VAR-REGISTER C1ASSOC +- CONS-TO-LISTA WT-LIST C1NTHCDR-CONDITION +- C1MULTIPLE-VALUE-CALL CHECK-DOWNWARD TYPE-FILTER +- C2TAGBODY-LOCAL BLK-NAME C1FSET T1DEFENTRY C1MEMBER +- C1GETHASH C2GO-CCB SCH-LOCAL-FUN C1RPLACD C1RPLACA-NTHCDR +- INLINE-POSSIBLE C1MAPC C2VAR WT-FUNCALL-C C1ADD-GLOBALS +- FUN-NAME SAVE-FUNOB FUN-CFUN PROCLAIM TAG-REF-CCB +- FIXNUM-LOC-P UNWIND-NO-EXIT WT-H1 MAXARGS C1GO INFO-P TAG-P +- C1AND INLINE-TYPE VAR-REF-CCB C1MULTIPLE-VALUE-BIND C1THE +- C2DM-RESERVE-VL WT-DOWNWARD-CLOSURE-MACRO VAR-NAME C1THROW +- INFO-TYPE C1ASH-CONDITION LTVP-EVAL CHARACTER-LOC-P +- C2DOWNWARD-FUNCTION C1EXPR C1TAGBODY BLK-REF INFO-VOLATILE +- VAR-REF CONSTANT-FOLD-P WT-DATA-PACKAGE-OPERATION FUN-P +- VAR-LOC C1PROGN C1NTHCDR VOLATILE TAG-UNWIND-EXIT +- REPLACE-CONSTANT NAME-TO-SD SET-TOP C1GET PUSH-ARGS +- FUN-REF-CCB INLINE-BOOLE3-STRING C1SETQ C1LOCAL-CLOSURE +- CLINK GET-INCLUDED SET-PUSH-CATCH-FRAME FUNCTION-ARG-TYPES +- T2DECLARE OBJECT-TYPE CHECK-VREF COPY-INFO +- T1DEFINE-STRUCTURE C1BOOLE3 FUN-LEVEL C1NTH C2GET FIX-OPT +- C1OR FUNCTION-RETURN-TYPE T1DEFUN T1CLINES FLAGS-POS +- SAVE-AVMA WT-DOWN C2GO-CLB C1SWITCH WT-SWITCH-CASE +- C1FUNCTION C2RPLACD C1LABELS C1MULTIPLE-VALUE-SETQ WT-VV +- C2TAGBODY-CLB WT-CADR C1MAPCAR MACRO-DEF-P T1DEFMACRO +- SET-RETURN THE-PARAMETER BLK-REF-CCB AET-C-TYPE +- PUSH-ARGS-LISPCALL WRITE-BLOCK-OPEN SET-UP-VAR-CVS TAG-VAR +- INFO-SP-CHANGE ADD-LOOP-REGISTERS C1MULTIPLE-VALUE-PROG1 +- WT-VS C2LOCATION C1COMPILER-LET T3CLINES RESULT-TYPE +- PROCLAMATION C1MAPL C1PRINC TAG-LABEL C2FUNCALL-AUX BLK-VAR +- TAG-REF-CLB C2TAGBODY-CCB VERIFY-DATA-VECTOR C1MAPCAN +- BLK-EXIT WT-VS-BASE REGISTER UNDEFINED-VARIABLE +- SYSTEM:UNDEF-COMPILER-MACRO C1BLOCK C1MAPLIST +- ARGS-CAUSE-SIDE-EFFECT C2BIND C1LET WT-SYMBOL-FUNCTION +- CMP-MACRO-FUNCTION WT1 C1MEMQ BLK-REF-CLB ADD-ADDRESS +- GET-LOCAL-ARG-TYPES C1UNWIND-PROTECT REP-TYPE ADD-CONSTANT +- C1IF C1QUOTE C1FMLA-CONSTANT WT-DATA1 NAME-SD1 BLK-P +- C1CATCH CMP-MACROEXPAND SHORT-FLOAT-LOC-P T3ORDINARY +- C1LENGTH NEED-TO-SET-VS-POINTERS C1DOWNWARD-FUNCTION C1FLET +- TAG-SWITCH TAG-REF PARSE-CVSPECS TAG-NAME VAR-P VAR-KIND +- C1VREF C2GETHASH LONG-FLOAT-LOC-P C1MAPCON C1NTH-CONDITION +- WT-FUNCTION-LINK WT-VAR-DECL C1STACK-LET ADD-SYMBOL T1DEFLA +- C2EXPR* C1LOAD-TIME-VALUE C1DM-BAD-KEY C1PROGV FSET-FN-NAME +- C2VALUES FUN-REF C2VAR-KIND C1PSETQ VARARG-P T1ORDINARY +- C2GO-LOCAL C1LET* C2DM-RESERVE-V PUSH-DATA-INCF +- C1DEFINE-STRUCTURE DEFAULT-INIT MDELETE-FILE +- C1BOOLE-CONDITION C2RPLACA C1VALUES GET-ARG-TYPES WT-CAR +- FUN-INFO C1DECLARE C1STRUCTURE-SET WT-VS* CMP-MACROEXPAND-1 +- SCH-GLOBAL GET-LOCAL-RETURN-TYPE C1EVAL-WHEN C2TAGBODY-BODY +- C1APPLY C1LOCAL-FUN C1MACROLET ADD-OBJECT C1RETURN-FROM +- SAFE-SYSTEM RESET-INFO-TYPE T1DEFCFUN C1RPLACA WT-CDR +- VAR-TYPE T1MACROLET C1LIST-NTH INFO-CHANGED-ARRAY +- INFO-REFERRED-ARRAY BLK-VALUE-TO-GO ADD-OBJECT2 WT-CCB-VS)) +-(PROCLAIM '(FTYPE (FUNCTION (*) *) INLINE-BOOLE3)) +-(PROCLAIM '(FTYPE (FUNCTION (T) FIXNUM) F-TYPE)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T (VECTOR T) FIXNUM T) FIXNUM) PUSH-ARRAY)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T (VECTOR T) FIXNUM FIXNUM T) FIXNUM) +- BSEARCHLEQ)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) *) C2EXPR WT-FIXNUM-LOC WT-LONG-FLOAT-LOC +- C2OR WT-SHORT-FLOAT-LOC CMP-EVAL C2PROGN WT-TO-STRING +- SET-LOC CMP-TOPLEVEL-EVAL VV-STR T1EXPR T1EVAL-WHEN WT-LOC +- C2AND WT-CHARACTER-LOC)) +-(PROCLAIM +- '(FTYPE (FUNCTION (*) T) FCALLN-INLINE MAKE-BLK MAKE-FUN +- LIST*-INLINE WT-CLINK COMPILE-FILE C2FSET MAKE-TAG CS-PUSH +- LIST-INLINE MAKE-VAR COMPILER-COMMAND MAKE-INFO)) +-(PROCLAIM +- '(FTYPE (FUNCTION (STRING FIXNUM FIXNUM) T) DASH-TO-UNDERSCORE-INT)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T) *) C2COMPILER-LET C2FLET C2LABELS C2IF +- WT-INLINE)) +-(PROCLAIM '(FTYPE (FUNCTION (T T *) *) T3DEFUN-AUX)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T) *) C1DM-V C2RETURN-FROM C2DM C1DM-VL +- C2APPLY-OPTIMIZE)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T) T) C2APPLY C2RETURN-CCB C2BIND-INIT +- PROCLAIM-VAR PRIN1-CMP C2LAMBDA-EXPR-WITH-KEY +- SYSTEM::ADD-DEBUG C2LAMBDA-EXPR-WITHOUT-KEY C2STACK-LET +- MULTIPLE-VALUE-CHECK C1DECL-BODY COMPILER-CC C1EXPR* +- C2MULTIPLE-VALUE-PROG1 CO1VECTOR-PUSH +- ARGS-INFO-CHANGED-VARS C2DM-BIND-INIT C1PROGN* +- CO1WRITE-CHAR COERCE-LOC WT-FIXNUM-VALUE IS-REP-REFERRED +- C2MULTIPLE-VALUE-CALL CO1SPECIAL-FIX-DECL INLINE-PROC +- WT-CHARACTER-VALUE SET-VS C2PSETQ T3SHARP-COMMA +- STRUCT-TYPE-OPT WT-MAKE-DCLOSURE C2DM-BIND-VL SET-JUMP-TRUE +- DO-MACRO-EXPANSION CO1SCHAR C2BLOCK-CLB +- C2LIST-NTH-IMMEDIATE C2DM-BIND-LOC WT-LONG-FLOAT-VALUE +- CO1CONS COMPILER-CLEAR-COMPILER-PROPERTIES C2EXPR-TOP +- ARGS-INFO-REFERRED-VARS C2MEMBER!2 C2MULTIPLE-VALUE-SETQ +- C2SETQ ADD-DEBUG-INFO GET-INLINE-LOC RESULT-TYPE-FROM-ARGS +- C2BIND-LOC CO1STRUCTURE-PREDICATE C1ARGS SHIFT<< UNWIND-BDS +- MAYBE-EVAL C2UNWIND-PROTECT TYPE-AND C2CALL-LOCAL C2THROW +- CO1TYPEP SET-BDS-BIND C1SETQ1 C2CATCH TYPE>= C1LAMBDA-FUN +- NEED-TO-PROTECT C2ASSOC!2 CO1READ-BYTE CO1LDB +- CONVERT-CASE-TO-SWITCH FAST-READ MAKE-USER-INIT +- CO1CONSTANT-FOLD C1FMLA CHECK-FNAME-ARGS +- COERCE-LOC-STRUCTURE-REF WT-SHORT-FLOAT-VALUE C2BLOCK-CCB +- ADD-INFO CAN-BE-REPLACED CO1READ-CHAR C2CALL-LAMBDA +- CFAST-WRITE PUSH-CHANGED-VARS SHIFT>> JUMPS-TO-P CO1SUBLIS +- C1CONSTANT-VALUE C2RETURN-CLB WT-VAR CHECK-END C2EXPR-TOP* +- WT-V*-MACROS SET-JUMP-FALSE CMPFIX-ARGS SET-DBIND +- CO1WRITE-BYTE CO1EQL COMPILER-DEF-HOOK WT-REQUIREDS)) +-(PROCLAIM '(FTYPE (FUNCTION (T *) *) COMPILE-FILE1)) +-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM FIXNUM) T) MLIN)) +-(PROCLAIM '(FTYPE (FUNCTION (STRING) T) DASH-TO-UNDERSCORE)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T) FIXNUM) PROCLAIMED-ARGD ANALYZE-REGS1 +- ANALYZE-REGS)) +-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM) T) MEMOIZED-HASH-EQUAL)) +-(PROCLAIM '(FTYPE (FUNCTION ((VECTOR T)) T) COPY-ARRAY)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T) *) C2BLOCK-LOCAL C1SYMBOL-FUN C1BODY +- C2BLOCK C2DECL-BODY C2RETURN-LOCAL NCONC-FILES +- WT-INLINE-LOC COMPILER-BUILD)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T *) T) WT-CVAR C1LAMBDA-EXPR UNWIND-EXIT +- CMPWARN WT-COMMENT WT-INTEGER-LOC CMPERR ADD-INIT +- FAST-LINK-PROCLAIMED-TYPE-P CMPNOTE C1CASE INIT-NAME)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T) T) T3DEFUN-VARARG C2STRUCTURE-REF +- C2CALL-UNKNOWN-GLOBAL C1MAKE-VAR C2SWITCH WT-GLOBAL-ENTRY +- C2CALL-GLOBAL T3INIT-FUN MY-CALL T3DEFUN-NORMAL)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T) T) CJT WT-INLINE-INTEGER CMP-EXPAND-MACRO +- CHECK-FORM-TYPE SET-VAR C2CASE ADD-FUNCTION-PROCLAMATION +- INLINE-TYPE-MATCHES T3DEFCFUN C2MAPCAN AND-FORM-TYPE +- C2PROGV C1DM WT-INLINE-CHARACTER C2MULTIPLE-VALUE-BIND +- C2FUNCALL-SFUN C2LET MYSUB C-FUNCTION-NAME WT-MAKE-CCLOSURE +- C2GO WT-INLINE-COND ADD-FAST-LINK C1STRUCTURE-REF1 C2MAPCAR +- BOOLE3 TOO-FEW-ARGS FIX-DOWN-ARGS COMPILER-PASS2 +- GET-INLINE-INFO C2LET* WT-INLINE-SHORT-FLOAT +- WT-IF-PROCLAIMED C2PRINC ASSIGN-DOWN-VARS +- WT-INLINE-LONG-FLOAT C2TAGBODY C1MAP-FUNCTIONS CHECK-VDECL +- MAKE-INLINE-STRING WT-INLINE-FIXNUM C2MAPC CAN-BE-REPLACED* +- SUBLIS1-INLINE TOO-MANY-ARGS ADD-FUNCTION-DECLARATION CJF)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T *) T) T3LOCAL-DCFUN T3LOCAL-FUN)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T) T) T2DEFUN T3DEFUN C2STRUCTURE-SET +- C1APPLY-OPTIMIZE T3DEFUN-LOCAL-ENTRY)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T *) T) WT-SIMPLE-CALL GET-OUTPUT-PATHNAME)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T *) T) INLINE-ARGS C2FUNCALL C2LAMBDA-EXPR +- LINK)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T) T) T3DEFMACRO DEFSYSFUN T2DEFENTRY +- T2DEFMACRO T3DEFENTRY)) +-(PROCLAIM +- '(FTYPE (FUNCTION NIL T) WT-DATA-BEGIN PRINT-COMPILER-INFO +- GAZONK-NAME CCB-VS-PUSH INC-INLINE-BLOCKS +- PRINT-CURRENT-FORM C1NIL WT-DATA-FILE +- ADD-LOAD-TIME-SHARP-COMMA CVS-PUSH RESET-TOP WT-CVARS +- BABOON WT-FASD-DATA-FILE WT-DATA-END INIT-ENV +- TAIL-RECURSION-POSSIBLE WFS-ERROR C1T VS-PUSH +- WT-NEXT-VAR-ARG WT-FIRST-VAR-ARG WT-C-PUSH +- CLOSE-INLINE-BLOCKS)) +\ No newline at end of file ++(COMMON-LISP::IN-PACKAGE "COMPILER") ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::STRING COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::TS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1VALUES ++ COMPILER::C1RPLACA COMPILER::FUN-P ++ COMPILER::FUNCTION-ARG-TYPES COMPILER::C1STRUCTURE-REF ++ COMPILER::GET-RETURN-TYPE COMPILER::WT-FUNCALL-C ++ COMPILER::MACRO-DEF-P COMPILER::T1DEFUN COMPILER::C1ASSOC ++ COMPILER::SET-UP-VAR-CVS COMPILER::C2FUNCTION ++ COMPILER::C1DM-BAD-KEY COMPILER::ADD-OBJECT ++ COMPILER::WT-SWITCH-CASE COMPILER::VARARG-P ++ COMPILER::C1TAGBODY COMPILER::C2GET COMPILER::VAR-REF ++ COMPILER::SCH-LOCAL-FUN COMPILER::ADD-SYMBOL ++ COMPILER::TAG-UNWIND-EXIT COMPILER::C1MULTIPLE-VALUE-SETQ ++ COMPILER::C1PRINC COMPILER::WT-VAR-DECL COMPILER::C1QUOTE ++ COMPILER::C2RPLACD COMPILER::CHECK-VREF ++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1MAPLIST ++ COMPILER::ADD-REG1 COMPILER::C1OR COMPILER::WT-SYMBOL-FUNCTION ++ COMPILER::TAG-P COMPILER::SAFE-SYSTEM COMPILER::C1ECASE ++ COMPILER::LTVP COMPILER::GET-INCLUDED COMPILER::INFO-P ++ COMPILER::FUN-INFO COMPILER::C1LOAD-TIME-VALUE ++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::BLK-P ++ COMPILER::BLK-EXIT COMPILER::C2VAR-KIND COMPILER::C2LOCATION ++ COMPILER::WT1 COMPILER::WT-CCB-VS ++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::BLK-REF-CCB ++ COMPILER::UNDEFINED-VARIABLE COMPILER::C1MULTIPLE-VALUE-CALL ++ COMPILER::VAR-LOC COMPILER::C1SETQ COMPILER::C1NTH-CONDITION ++ COMPILER::C2RPLACA COMPILER::FUN-REF COMPILER::C2VAR ++ COMPILER::WT-CAR COMPILER::WT-LIST COMPILER::WRITE-BLOCK-OPEN ++ COMPILER::INFO-VOLATILE COMPILER::GET-LOCAL-RETURN-TYPE ++ COMPILER::AET-C-TYPE COMPILER::PUSH-ARGS COMPILER::TAG-REF-CLB ++ COMPILER::BLK-REF COMPILER::VAR-P COMPILER::C1ADD-GLOBALS ++ COMPILER::T3ORDINARY COMPILER::ADD-OBJECT2 COMPILER::SET-TOP ++ COMPILER::T1DEFLA COMPILER::C1FUNCTION COMPILER::T3CLINES ++ COMPILER::T1DEFCFUN COMPILER::C1VREF COMPILER::C1ASH ++ COMPILER::BLK-NAME COMPILER::WT-CADR COMPILER::WT-DOWN ++ COMPILER::C1TERPRI COMPILER::C2GETHASH COMPILER::C2GO-CCB ++ COMPILER::SAVE-FUNOB COMPILER::T2DECLARE COMPILER::FUN-REF-CCB ++ COMPILER::C1MAPCAR COMPILER::T1DEFMACRO ++ COMPILER::C2TAGBODY-LOCAL COMPILER::C1STACK-LET ++ COMPILER::INFO-TYPE COMPILER::T1MACROLET COMPILER::C1LET* ++ COMPILER::C1RPLACD COMPILER::DECLARATION-TYPE ++ COMPILER::T1ORDINARY COMPILER::C2EXPR* COMPILER::C1LOCAL-FUN ++ COMPILER::WT-DATA-PACKAGE-OPERATION ++ COMPILER::C1BOOLE-CONDITION SYSTEM::UNDEF-COMPILER-MACRO ++ COMPILER::C2TAGBODY-BODY COMPILER::C1NTHCDR COMPILER::C1VAR ++ COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::C1NTHCDR-CONDITION ++ COMPILER::CONSTANT-FOLD-P COMPILER::C1UNWIND-PROTECT ++ COMPILER::PROCLAMATION COMPILER::C1NTH COMPILER::C1RETURN-FROM ++ COMPILER::INFO-SP-CHANGE COMPILER::C1LENGTH ++ COMPILER::CMP-MACRO-FUNCTION COMPILER::BLK-REF-CLB ++ COMPILER::NAME-TO-SD COMPILER::CTOP-WRITE COMPILER::C1MAPCON ++ COMPILER::C1FUNOB COMPILER::FIX-OPT COMPILER::C1RPLACA-NTHCDR ++ COMPILER::C1FLET COMPILER::RESULT-TYPE COMPILER::C1CATCH ++ COMPILER::C2DM-RESERVE-V COMPILER::VAR-NAME ++ COMPILER::CMP-MACROEXPAND COMPILER::VERIFY-DATA-VECTOR ++ COMPILER::T1CLINES COMPILER::C1MAPL COMPILER::T1DEFENTRY ++ COMPILER::TAG-REF-CCB COMPILER::WT-VS ++ COMPILER::LONG-FLOAT-LOC-P COMPILER::C1MAPCAN ++ COMPILER::OBJECT-TYPE COMPILER::ADD-ADDRESS ++ COMPILER::RESET-INFO-TYPE COMPILER::C1BOOLE3 COMPILER::C1MEMQ ++ COMPILER::C1DEFINE-STRUCTURE COMPILER::TYPE-FILTER ++ COMPILER::UNWIND-NO-EXIT COMPILER::C1FMLA-CONSTANT ++ COMPILER::C2DM-RESERVE-VL COMPILER::C1FSET COMPILER::LTVP-EVAL ++ COMPILER::C1GO COMPILER::WT-VV COMPILER::INFO-CHANGED-ARRAY ++ COMPILER::C1FUNCALL COMPILER::C2TAGBODY-CCB ++ COMPILER::TAG-LABEL COMPILER::VAR-KIND COMPILER::WT-VS* ++ COMPILER::VAR-TYPE COMPILER::C2GO-LOCAL COMPILER::REGISTER ++ COMPILER::T1PROGN COMPILER::C1BLOCK COMPILER::TAG-SWITCH ++ COMPILER::VAR-REP-LOC COMPILER::C2BIND ++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::COPY-INFO ++ COMPILER::C1LIST-NTH COMPILER::CONS-TO-LISTA ++ COMPILER::FUN-LEVEL COMPILER::C1DOWNWARD-FUNCTION ++ COMPILER::THE-PARAMETER COMPILER::C2VALUES COMPILER::C1LABELS ++ COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::MDELETE-FILE ++ COMPILER::WT-FUNCTION-LINK COMPILER::SAVE-AVMA ++ COMPILER::VOLATILE COMPILER::ADD-CONSTANT COMPILER::C1APPLY ++ COMPILER::C1GETHASH COMPILER::FUN-NAME COMPILER::DEFAULT-INIT ++ COMPILER::CLINK COMPILER::WT-CDR COMPILER::PARSE-CVSPECS ++ COMPILER::REP-TYPE COMPILER::C2GO-CLB ++ COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::PUSH-DATA-INCF ++ COMPILER::SCH-GLOBAL COMPILER::C1STRUCTURE-SET ++ COMPILER::TAG-NAME COMPILER::INFO-REFERRED-ARRAY ++ COMPILER::C1EXPR COMPILER::C1GET COMPILER::BLK-VAR ++ COMPILER::TAG-REF COMPILER::C1MAPC COMPILER::SET-RETURN ++ COMPILER::SHORT-FLOAT-LOC-P COMPILER::C1DECLARE ++ COMPILER::WT-DATA1 COMPILER::FLAGS-POS ++ COMPILER::BLK-VALUE-TO-GO COMPILER::NAME-SD1 ++ COMPILER::C2DOWNWARD-FUNCTION COMPILER::C1SHARP-COMMA ++ COMPILER::INLINE-POSSIBLE COMPILER::WT-H1 ++ COMPILER::FIXNUM-LOC-P COMPILER::C1LET COMPILER::C1IF ++ COMPILER::C1THE COMPILER::FUNCTION-RETURN-TYPE ++ COMPILER::GET-ARG-TYPES COMPILER::INLINE-TYPE ++ COMPILER::FUN-CFUN COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P ++ COMPILER::CHECK-DOWNWARD COMPILER::C1PSETQ ++ COMPILER::INLINE-BOOLE3-STRING COMPILER::C1THROW ++ COMPILER::FSET-FN-NAME COMPILER::T1DEFINE-STRUCTURE ++ COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C1PROGN ++ COMPILER::C2FUNCALL-AUX COMPILER::C1MACROLET COMPILER::C1AND ++ COMPILER::WT-VS-BASE COMPILER::ADD-LOOP-REGISTERS ++ COMPILER::VAR-REGISTER COMPILER::C1PROGV COMPILER::C1SWITCH ++ COMPILER::C1MEMBER COMPILER::C2TAGBODY-CLB ++ COMPILER::CMP-MACROEXPAND-1 COMMON-LISP::PROCLAIM ++ COMPILER::C1ASH-CONDITION COMPILER::C1EVAL-WHEN ++ COMPILER::C1LOCAL-CLOSURE COMPILER::REPLACE-CONSTANT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ COMPILER::INLINE-BOOLE3)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL ++ COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::WT-INLINE COMPILER::C2IF COMPILER::C2LABELS ++ COMPILER::C2FLET)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMPILER::T3DEFUN-AUX)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ COMPILER::F-TYPE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T) ++ COMPILER::DASH-TO-UNDERSCORE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::INIT-NAME COMPILER::ADD-INIT COMPILER::C1LAMBDA-EXPR ++ COMPILER::WT-CVAR COMPILER::C1CASE COMPILER::WT-COMMENT ++ COMPILER::CMPERR COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE ++ COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::UNWIND-EXIT ++ COMPILER::CMPWARN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::C2RETURN-LOCAL COMPILER::C2BLOCK-LOCAL ++ COMPILER::NCONC-FILES COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK ++ COMPILER::C1BODY COMPILER::COMPILER-BUILD ++ COMPILER::C2DECL-BODY COMPILER::WT-INLINE-LOC)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(COMPILER::CMP-ANON COMMON-LISP::COMPILE COMPILER::CMP-TMP-MACRO ++ COMMON-LISP::DISASSEMBLE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T) ++ COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM ++ COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ COMPILER::BSEARCHLEQ)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T) ++ COMMON-LISP::FIXNUM COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ COMPILER::PUSH-ARRAY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMPILER::AND-FORM-TYPE COMPILER::SET-VAR COMPILER::C2LET* ++ COMPILER::COMPILER-PASS2 COMPILER::ADD-FUNCTION-DECLARATION ++ COMPILER::BOOLE3 COMPILER::C1MAP-FUNCTIONS ++ COMPILER::TOO-MANY-ARGS COMPILER::CHECK-FORM-TYPE ++ COMPILER::C2LET COMPILER::C-FUNCTION-NAME ++ COMPILER::WT-INLINE-SHORT-FLOAT COMPILER::FIX-DOWN-ARGS ++ COMPILER::C2PRINC COMPILER::WT-IF-PROCLAIMED ++ COMPILER::ADD-FAST-LINK COMPILER::C2MULTIPLE-VALUE-BIND ++ COMPILER::C2MAPCAN COMPILER::CJT COMPILER::CHECK-VDECL ++ COMPILER::INLINE-TYPE-MATCHES COMPILER::WT-INLINE-LONG-FLOAT ++ COMPILER::C2GO COMPILER::CAN-BE-REPLACED* COMPILER::MYSUB ++ COMPILER::ASSIGN-DOWN-VARS COMPILER::C2MAPC ++ COMPILER::WT-INLINE-INTEGER COMPILER::GET-INLINE-INFO ++ COMPILER::CJF COMPILER::TOO-FEW-ARGS COMPILER::T3DEFCFUN ++ COMPILER::CMP-EXPAND-MACRO COMPILER::WT-MAKE-CCLOSURE ++ COMPILER::C2FUNCALL-SFUN COMPILER::C1DM ++ COMPILER::WT-INLINE-COND COMPILER::C2TAGBODY ++ COMPILER::WT-INLINE-CHARACTER COMPILER::C2PROGV ++ COMPILER::C2MAPCAR COMPILER::C1STRUCTURE-REF1 COMPILER::C2CASE ++ COMPILER::ADD-FUNCTION-PROCLAMATION ++ COMPILER::MAKE-INLINE-STRING COMPILER::SUBLIS1-INLINE ++ COMPILER::WT-INLINE-FIXNUM)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK ++ COMPILER::INLINE-ARGS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMPILER::C2STRUCTURE-REF COMPILER::WT-GLOBAL-ENTRY ++ COMPILER::T3DEFUN-VARARG COMPILER::T3DEFUN-NORMAL ++ COMPILER::C2CALL-GLOBAL COMPILER::C1MAKE-VAR ++ COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::C2SWITCH ++ COMPILER::T3INIT-FUN COMPILER::MY-CALL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO COMPILER::T2DEFENTRY ++ COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMPILER::T2DEFUN COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN ++ COMPILER::C2STRUCTURE-SET COMPILER::T3DEFUN-LOCAL-ENTRY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::WT-SIMPLE-CALL COMPILER::GET-OUTPUT-PATHNAME)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2EXPR ++ COMPILER::WT-FIXNUM-LOC COMPILER::WT-CHARACTER-LOC ++ COMPILER::C2AND COMPILER::T1EXPR COMPILER::CMP-TOPLEVEL-EVAL ++ COMPILER::WT-SHORT-FLOAT-LOC COMPILER::C2OR COMPILER::WT-LOC ++ COMPILER::CMP-EVAL COMPILER::T1EVAL-WHEN COMPILER::SET-LOC ++ COMPILER::VV-STR COMPILER::WT-TO-STRING)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ COMPILER::MAKE-FUN COMPILER::MAKE-BLK ++ COMMON-LISP::COMPILE-FILE COMPILER::FCALLN-INLINE ++ COMPILER::MAKE-INFO COMPILER::CS-PUSH COMPILER::MAKE-VAR ++ COMPILER::LIST-INLINE COMPILER::C2FSET COMPILER::WT-CLINK ++ COMPILER::COMPILER-COMMAND COMPILER::MAKE-TAG ++ COMPILER::LIST*-INLINE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ((COMMON-LISP::VECTOR COMMON-LISP::T)) ++ COMMON-LISP::T) ++ COMPILER::COPY-ARRAY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMPILER::C2EXPR-TOP COMPILER::CO1SUBLIS ++ COMPILER::C2CALL-LAMBDA COMPILER::GET-INLINE-LOC ++ COMPILER::CHECK-END COMPILER::C2PSETQ COMPILER::TYPE-AND ++ COMPILER::TYPE>= COMPILER::C2MULTIPLE-VALUE-PROG1 ++ COMPILER::CO1SCHAR SYSTEM::ADD-DEBUG COMPILER::C2BLOCK-CCB ++ COMPILER::C2DM-BIND-VL COMPILER::MAKE-USER-INIT ++ COMPILER::NEED-TO-PROTECT COMPILER::FAST-READ ++ COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::C2BIND-INIT ++ COMPILER::JUMPS-TO-P COMPILER::C2MEMBER!2 ++ COMPILER::C2CALL-LOCAL COMPILER::C2BLOCK-CLB ++ COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::INLINE-PROC ++ COMPILER::C2THROW COMPILER::C1DECL-BODY ++ COMPILER::WT-MAKE-DCLOSURE COMPILER::CO1WRITE-CHAR ++ COMPILER::C1SETQ1 COMPILER::SET-JUMP-FALSE COMPILER::CO1CONS ++ COMPILER::CO1VECTOR-PUSH COMPILER::SET-VS COMPILER::SHIFT>> ++ COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::WT-FIXNUM-VALUE ++ COMPILER::C2CATCH COMPILER::C2RETURN-CCB COMPILER::MAYBE-EVAL ++ COMPILER::C2ASSOC!2 COMPILER::C2DM-BIND-INIT ++ COMPILER::C2STACK-LET COMPILER::C2LAMBDA-EXPR-WITH-KEY ++ COMPILER::ARGS-INFO-REFERRED-VARS ++ COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C1PROGN* ++ COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2MULTIPLE-VALUE-CALL ++ COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::CO1CONSTANT-FOLD ++ COMPILER::C1CONSTANT-VALUE COMPILER::C1EXPR* ++ COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2RETURN-CLB ++ COMPILER::CMPFIX-ARGS COMPILER::PROCLAIM-VAR COMPILER::C2APPLY ++ COMPILER::DO-MACRO-EXPANSION COMPILER::CFAST-WRITE ++ COMPILER::PRIN1-CMP COMPILER::SHIFT<< COMPILER::WT-REQUIREDS ++ COMPILER::C2EXPR-TOP* COMPILER::UNWIND-BDS ++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::COERCE-LOC ++ COMPILER::STRUCT-TYPE-OPT COMPILER::CO1READ-CHAR ++ COMPILER::ADD-DEBUG-INFO COMPILER::C2LIST-NTH-IMMEDIATE ++ COMPILER::WT-VAR COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY ++ COMPILER::CHECK-FNAME-ARGS COMPILER::CAN-BE-REPLACED ++ COMPILER::WT-CHARACTER-VALUE COMPILER::C2UNWIND-PROTECT ++ COMPILER::SET-DBIND COMPILER::T3SHARP-COMMA ++ COMPILER::IS-REP-REFERRED COMPILER::C1FMLA ++ COMPILER::WT-V*-MACROS COMPILER::C2DM-BIND-LOC ++ COMPILER::C2BIND-LOC ++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES ++ COMPILER::ADD-INFO COMPILER::C2SETQ ++ COMPILER::PUSH-CHANGED-VARS COMPILER::CO1STRUCTURE-PREDICATE ++ COMPILER::SET-BDS-BIND COMPILER::SET-JUMP-TRUE ++ COMPILER::CO1READ-BYTE COMPILER::C1LAMBDA-FUN ++ COMPILER::CO1TYPEP COMPILER::CONVERT-CASE-TO-SWITCH ++ COMPILER::COMPILER-DEF-HOOK COMPILER::CO1LDB COMPILER::C1ARGS ++ COMPILER::CO1WRITE-BYTE COMPILER::CO1EQL ++ COMPILER::COMPILER-CC)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) COMMON-LISP::T) ++ COMPILER::MLIN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMPILER::COMPILE-FILE1)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ COMPILER::WT-DATA-BEGIN COMPILER::WT-C-PUSH COMPILER::WT-CVARS ++ COMPILER::C1T COMPILER::CVS-PUSH COMPILER::WT-DATA-FILE ++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA ++ COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-FASD-DATA-FILE ++ COMPILER::GAZONK-NAME COMPILER::WFS-ERROR ++ COMPILER::WT-NEXT-VAR-ARG COMPILER::WT-FIRST-VAR-ARG ++ COMPILER::C1NIL COMPILER::WT-DATA-END COMPILER::RESET-TOP ++ COMPILER::TAIL-RECURSION-POSSIBLE ++ COMPILER::PRINT-COMPILER-INFO COMPILER::CCB-VS-PUSH ++ COMPILER::BABOON COMPILER::INIT-ENV ++ COMPILER::PRINT-CURRENT-FORM COMPILER::VS-PUSH ++ COMPILER::INC-INLINE-BLOCKS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::FIXNUM) ++ COMMON-LISP::T) ++ COMPILER::MEMOIZED-HASH-EQUAL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1 ++ COMPILER::ANALYZE-REGS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::STRING COMMON-LISP::FIXNUM ++ COMMON-LISP::FIXNUM) ++ COMMON-LISP::T) ++ COMPILER::DASH-TO-UNDERSCORE-INT)) +\ No newline at end of file +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -7569,9 +7569,6 @@ fi + + if test "$enable_ansi" = "yes" ; then + SYSTEM=ansi_gcl +- +-$as_echo "#define ANSI_COMMON_LISP 1" >>confdefs.h +- + CLSTANDARD=ANSI + else + SYSTEM=gcl +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -2112,7 +2112,6 @@ AC_ARG_ENABLE(ansi,[--enable-ansi builds + + if test "$enable_ansi" = "yes" ; then + SYSTEM=ansi_gcl +- AC_DEFINE(ANSI_COMMON_LISP,1,[compile ansi compliant image]) + CLSTANDARD=ANSI + else + SYSTEM=gcl +--- gcl-2.6.12.orig/h/amd64-linux.h ++++ gcl-2.6.12/h/amd64-linux.h +@@ -21,3 +21,4 @@ + #define C_GC_OFFSET 4 + + #define RELOC_H "elf64_i386_reloc.h" ++#define MAX_CODE_ADDRESS (1L<<31)/*large memory model broken gcc 4.8*/ +--- gcl-2.6.12.orig/h/att_ext.h ++++ gcl-2.6.12/h/att_ext.h +@@ -145,8 +145,8 @@ object simple_lispcall(); + object simple_lispcall_no_event(); + object simple_symlispcall(); + object simple_symlispcall_no_event(); +-EXTER object Vevalhook; +-EXTER object Vapplyhook; ++EXTER object siVevalhook; ++EXTER object siVapplyhook; + object ieval(); + object ifuncall(object,int,...); + object ifuncall1(); +@@ -301,13 +301,13 @@ EXTER object sLquote; + + EXTER object sLlambda; + +-EXTER object sLlambda_block; +-EXTER object sLlambda_closure; +-EXTER object sLlambda_block_closure; ++EXTER object sSlambda_block; ++EXTER object sSlambda_closure; ++EXTER object sSlambda_block_closure; + + EXTER object sLfunction; +-EXTER object sLmacro; +-EXTER object sLtag; ++EXTER object sSmacro; ++EXTER object sStag; + EXTER object sLblock; + + +@@ -359,9 +359,6 @@ object shift_integer(); + /* package.d */ + EXTER object lisp_package; + EXTER object user_package; +-#ifdef ANSI_COMMON_LISP +-EXTER object common_lisp_package; +-#endif + EXTER object keyword_package; + EXTER object system_package; + EXTER object sLApackageA; +@@ -565,15 +562,13 @@ EXTER object sSfunction_documentation; + /* typespec.c */ + EXTER object sLcommon,sLnull,sLcons,sLlist,sLsymbol,sLarray,sLvector,sLbit_vector,sLstring; + EXTER object sLsequence,sLsimple_array,sLsimple_vector,sLsimple_bit_vector,sLsimple_string; +-EXTER object sLcompiled_function,sLpathname,sLcharacter,sLnumber,sLrational,sLfloat,sLstring_char; ++EXTER object sLcompiled_function,sLpathname,sLcharacter,sLnumber,sLrational,sLfloat; + EXTER object sLinteger,sLreal,sLratio,sLshort_float,sLstandard_char,sLfixnum,sLpositive_fixnum, sLcomplex; + EXTER object sLsingle_float,sLpackage,sLbignum,sLrandom_state,sLdouble_float,sLstream,sLbit,sLreadtable; + EXTER object sLlong_float,sLhash_table,sLstructure,sLboolean; + EXTER object sLdivision_by_zero,sLfloating_point_inexact,sLfloating_point_invalid_operation; + EXTER object sLfloating_point_overflow,sLfloating_point_underflow; + +-/* #ifdef ANSI_COMMON_LISP */ +-/* new ansi types */ + EXTER object sLarithmetic_error,sLbase_char,sLbase_string,sLbroadcast_stream,sLbuilt_in_class; + EXTER object sLcell_error,sLclass,sLconcatenated_stream,sLcondition,sLcontrol_error; + EXTER object sLecho_stream,sLend_of_file,sLerror,sLextended_char,sLfile_error,sLfile_stream; +@@ -584,7 +579,6 @@ EXTER object sLstandard_generic_function + EXTER object sLstream_error,sLstring_stream,sLstructure_class,sLstyle_warning,sLsynonym_stream; + EXTER object sLtwo_way_stream,sLtype_error,sLunbound_slot,sLunbound_variable,sLundefined_function,sLwarning; + EXTER object sLmethod_combination,sLstructure_object; +-/* #endif */ + + EXTER object sLsatisfies; + EXTER object sLmember; +@@ -595,10 +589,10 @@ EXTER object sLvalues; + EXTER object sLmod; + EXTER object sLsigned_byte; + EXTER object sLunsigned_byte; +-EXTER object sLsigned_char; +-EXTER object sLunsigned_char; +-EXTER object sLsigned_short; +-EXTER object sLunsigned_short; ++EXTER object sSsigned_char; ++EXTER object sSunsigned_char; ++EXTER object sSsigned_short; ++EXTER object sSunsigned_short; + EXTER object sLA; + EXTER object sLplusp; + EXTER object TSor_symbol_string; +--- gcl-2.6.12.orig/h/compdefs.h ++++ gcl-2.6.12/h/compdefs.h +@@ -114,3 +114,4 @@ stp_ordinary + SIGNED_CHAR(x) + FEerror(x,y...) + FEwrong_type_argument(x,y) ++BIT_ENDIAN(x) +--- gcl-2.6.12.orig/h/elf64_i386_reloc.h ++++ gcl-2.6.12/h/elf64_i386_reloc.h +@@ -8,5 +8,6 @@ + add_val(where,~0L,s+a); + break; + case R_X86_64_PC32: ++ massert(ovchks(s+a-p,~MASK(32))); + add_val(where,MASK(32),s+a-p); + break; +--- gcl-2.6.12.orig/h/lu.h ++++ gcl-2.6.12/h/lu.h +@@ -94,12 +94,12 @@ struct symbol { + object s_dbind; + void (*s_sfdef) (); + char *s_self; ++ short s_stype; ++ short s_mflag; + int s_fillp; + object s_gfdef; + object s_plist; + object s_hpack; +- short s_stype; +- short s_mflag; + SPAD; + + }; +@@ -142,6 +142,7 @@ struct hashtable { + int ht_nent; + int ht_size; + short ht_test; ++ short ht_static; + SPAD; + + }; +@@ -152,10 +153,10 @@ struct array { + short a_rank; + short a_elttype; + object *a_self; +- short a_adjustable; +- short a_offset; + int a_dim; + int *a_dims; ++ short a_adjustable; ++ short a_offset; + SPAD; + + }; +@@ -168,8 +169,8 @@ struct vector { + short v_hasfillp; + short v_elttype; + object *v_self; +- int v_fillp; + int v_dim; ++ int v_fillp; + short v_adjustable; + short v_offset; + SPAD; +@@ -181,8 +182,8 @@ struct string { + short st_hasfillp; + short st_adjustable; + char *st_self; +- int st_fillp; + int st_dim; ++ int st_fillp; + }; + + struct ustring { +@@ -191,8 +192,8 @@ struct ustring { + short ust_hasfillp; + short ust_adjustable; + unsigned char *ust_self; +- int ust_fillp; + int ust_dim; ++ int ust_fillp; + }; + + struct bitvector { +@@ -201,8 +202,8 @@ struct bitvector { + short bv_hasfillp; + short bv_elttype; + char *bv_self; +- int bv_fillp; + int bv_dim; ++ int bv_fillp; + short bv_adjustable; + short bv_offset; + SPAD; +@@ -214,10 +215,10 @@ struct fixarray { + short fixa_rank; + short fixa_elttype; + fixnum *fixa_self; +- short fixa_adjustable; +- short fixa_offset; + int fixa_dim; + int *fixa_dims; ++ short fixa_adjustable; ++ short fixa_offset; + SPAD; + }; + +@@ -227,10 +228,10 @@ struct sfarray { + short sfa_rank; + short sfa_elttype; + shortfloat *sfa_self; +- short sfa_adjustable; +- short sfa_offset; + int sfa_dim; + int *sfa_dims; ++ short sfa_adjustable; ++ short sfa_offset; + SPAD; + }; + +@@ -240,10 +241,10 @@ struct lfarray { + short lfa_rank; + short lfa_elttype; + longfloat *lfa_self; +- short lfa_adjustable; +- short lfa_offset; + int lfa_dim; + int *lfa_dims; ++ short lfa_adjustable; ++ short lfa_offset; + SPAD; + }; + +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -22,9 +22,6 @@ void segmentation_catcher(); + EXTER int gc_enabled, saving_system; + + EXTER object lisp_package,user_package; +-#ifdef ANSI_COMMON_LISP +-EXTER object common_lisp_package; +-#endif + EXTER char *core_end; + EXTER int catch_fatal; + EXTER long real_maxpage; +@@ -105,6 +102,7 @@ void old(void) \ + #define make_function(a_,b_) make_function_internal(a_,FFN(b_)) + #define make_si_function(a_,b_) make_si_function_internal(a_,FFN(b_)) + #define make_special_form(a_,b_) make_special_form_internal(a_,FFN(b_)) ++#define make_si_special_form(a_,b_) make_si_special_form_internal(a_,FFN(b_)) + #define make_si_sfun(a_,b_,c_) make_si_sfun_internal(a_,FFN(b_),c_) + #define STATD static + #else +@@ -114,6 +112,7 @@ void old(void) \ + #define make_function(a_,b_) make_function_internal(a_,b_) + #define make_si_function(a_,b_) make_si_function_internal(a_,b_) + #define make_special_form(a_,b_) make_special_form_internal(a_,b_) ++#define make_si_special_form(a_,b_) make_si_special_form_internal(a_,b_) + #define make_si_sfun(a_,b_,c_) make_si_sfun_internal(a_,b_,c_) + #define STATD + #endif +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -77,7 +77,7 @@ Foundation, 675 Mass Ave, Cambridge, MA + Definition of the type of LISP objects. + */ + typedef union int_object iobject; +-union int_object {object o; fixnum i;}; ++union int_object {object *o; fixnum i;}; + + #define SMALL_FIXNUM_LIMIT 1024 + +@@ -150,6 +150,12 @@ enum aelttype { /* array element type + #define SET_BV_OFFSET(x,val) ((type_of(x)==t_bitvector ? x->bv.bv_offset = val : \ + type_of(x)== t_array ? x->a.a_offset=val : (abort(),0))) + ++#if !defined(DOUBLE_BIGENDIAN) ++#define BIT_ENDIAN(a_) (7-(a_)) ++#else ++#define BIT_ENDIAN(a_) (a_) ++#endif ++ + + #define S_DATA(x) ((struct s_data *)((x)->str.str_self)) + #define SLOT_TYPE(def,i) (((S_DATA(def))->raw->ust.ust_self[i])) +@@ -304,9 +310,9 @@ EXTER struct typemanager tm_table[ 32 / + /* + Contiguous block header. + */ +-EXTER bool prefer_low_mem_contblock; ++EXTER ufixnum contblock_lim; + struct contblock { /* contiguous block header */ +- int cb_size; /* size in bytes */ ++ ufixnum cb_size; /* size in bytes */ + struct contblock + *cb_link; /* contiguous block link */ + }; +@@ -324,7 +330,6 @@ EXTER struct contblock *old_cb_pointer; + /* + Variables for memory management. + */ +-EXTER long ncb; /* number of contblocks */ + #define ncbpage tm_table[t_contiguous].tm_npage + #define maxcbpage tm_table[t_contiguous].tm_maxpage + #define cbgbccount tm_table[t_contiguous].tm_gbccount +@@ -337,15 +342,12 @@ EXTER long holepage; /* hole pages * + EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult; + + +-#ifdef SGC +-EXTER char *old_rb_start; /* read-only relblock start */ +-#endif + EXTER char *rb_start; /* relblock start */ + EXTER char *rb_end; /* relblock end */ + EXTER char *rb_limit; /* relblock limit */ + EXTER char *rb_pointer; /* relblock pointer */ +-EXTER char *rb_start1; /* relblock start in copy space */ +-EXTER char *rb_pointer1; /* relblock pointer in copy space */ ++/* EXTER char *rb_start1; /\* relblock start in copy space *\/ */ ++/* EXTER char *rb_pointer1; /\* relblock pointer in copy space *\/ */ + + EXTER char *heap_end; /* heap end */ + EXTER char *core_end; /* core end */ +--- gcl-2.6.12.orig/h/page.h ++++ gcl-2.6.12/h/page.h +@@ -21,9 +21,6 @@ + #define PTR_ALIGN SIZEOF_LONG + #endif + +-#define ROUND_UP_PTR(n) (((long)(n) + (PTR_ALIGN-1)) & ~(PTR_ALIGN-1)) +-#define ROUND_DOWN_PTR(n) (((long)(n) & ~(PTR_ALIGN-1))) +- + /* minimum size required for contiguous pointers */ + #if PTR_ALIGN < SIZEOF_CONTBLOCK + #define CPTR_SIZE SIZEOF_CONTBLOCK +@@ -31,9 +28,10 @@ + #define CPTR_SIZE PTR_ALIGN + #endif + +-#define ROUND_UP_PTR_CONT(n) (((long)(n) + (CPTR_SIZE-1)) & ~(CPTR_SIZE-1)) +-#define ROUND_DOWN_PTR_CONT(n) (((long)(n) & ~(CPTR_SIZE-1))) +- ++#define FLR(x,r) (((x))&~(r-1)) ++#define CEI(x,r) FLR((x)+(r-1),r) ++#define PFLR(x,r) ((void *)FLR((ufixnum)x,r)) ++#define PCEI(x,r) ((void *)CEI((ufixnum)x,r)) + + #ifdef SGC + +@@ -47,33 +45,25 @@ + + #define SGC_WRITABLE (SGC_PERM_WRITABLE | SGC_PAGE_FLAG) + +-#define WRITABLE_PAGE_P(p) IS_WRITABLE(p) +-#define ON_WRITABLE_PAGE(x) WRITABLE_PAGE_P(page(x)) +- +-#define IF_WRITABLE(x,if_code) ({if (IS_WRITABLE(page(x))) {if_code;}})/*FIXME maxpage*/ +- +-#define sgc_mark_object(x) IF_WRITABLE(x,if(!is_marked(x)) sgc_mark_object1(x)) +- + /* When not 0, the free lists in the type manager are freelists + on SGC_PAGE's, for those types supporting sgc. + Marking and sweeping is done specially */ + + int sgc_on; + ++#define SGC_WHOLE_PAGE /* disallow old data on sgc pages*/ + ++#ifndef SGC_WHOLE_PAGE + /* for the S field of the FIRSTWORD */ + enum sgc_type { SGC_NORMAL, /* not allocated since the last sgc */ + SGC_RECENT /* allocated since last sgc */ + }; +- ++#define SGC_OR_M(x) (!TYPEWORD_TYPE_P(pageinfo(x)->type) ? pageinfo(x)->sgc_flags&SGC_PAGE_FLAG : ((object)x)->d.s) ++#endif + + #define TM_BASE_TYPE_P(i) (tm_table[i].tm_type == i) + +-/* check if a relblock address is new relblock */ +-#define SGC_RELBLOCK_P(x) ((char *)(x) >= rb_start) +- + /* is this an sgc cell? encompasses all free cells. Used where cell cannot yet be marked */ +-#define SGC_OR_M(x) (!TYPEWORD_TYPE_P(pageinfo(x)->type) ? pageinfo(x)->sgc_flags&SGC_PAGE_FLAG : ((object)x)->d.s) + + #ifndef SIGPROTV + #define SIGPROTV SIGSEGV +@@ -107,28 +97,26 @@ extern fixnum writable_pages; + + #define CLEAR_WRITABLE(i) set_writable(i,0) + #define SET_WRITABLE(i) set_writable(i,1) +-#define IS_WRITABLE(i) is_writable(i) ++#define WRITABLE_PAGE_P(i) is_writable(i) ++#define CACHED_WRITABLE_PAGE_P(i) is_writable_cached(i) ++#define ON_WRITABLE_PAGE(x) WRITABLE_PAGE_P(page(x)) ++#define ON_WRITABLE_PAGE_CACHED(x) CACHED_WRITABLE_PAGE_P(page(x)) ++ + + + EXTER long first_data_page,real_maxpage,phys_pages,available_pages; +-EXTER void *data_start; ++EXTER void *data_start,*initial_sbrk; + + #if !defined(IN_MAIN) && defined(SGC) + #include "writable.h" + #endif + +-#ifdef SGC +-#define REAL_RB_START (sgc_enabled ? old_rb_start : rb_start) +-#else +-#define REAL_RB_START rb_start +-#endif +- + #define CB_BITS CPTR_SIZE*CHAR_SIZE + #define ceil(a_,b_) (((a_)+(b_)-1)/(b_)) + #define npage(m_) ceil(m_,PAGESIZE) + #define cpage(m_) ({ufixnum _m=(m_);ceil(sizeof(struct pageinfo)+_m+2*ceil(_m,(CB_BITS-2)),PAGESIZE);}) + #define mbytes(p_) ceil((p_)*PAGESIZE-sizeof(struct pageinfo),CB_BITS) +-#define tpage(tm_,m_) (tm_->tm_type==t_relocatable ? npage(m_-(rb_limit-rb_pointer)) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_))) ++#define tpage(tm_,m_) (tm_->tm_type==t_relocatable ? npage(m_-(rb_limit-rb_pointer)+1) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_))) + + #define CB_DATA_SIZE(z_) ({fixnum _z=(z_);_z*PAGESIZE-2*mbytes(_z)-sizeof(struct pageinfo);}) + #define CB_MARK_START(pi_) ((void *)(pi_)+sizeof(struct pageinfo)) +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -7,7 +7,7 @@ + /* alloc.c:364:OF */ extern object on_stack_cons (object x, object y); /* (x, y) object x; object y; */ + /* alloc.c:376:OF */ extern object fSallocated (object typ); /* (typ) object typ; */ + /* alloc.c:401:OF */ extern object fSreset_number_used (object typ); /* (typ) object typ; */ +-/* alloc.c:480:OF */ extern void insert_contblock (char *p, int s); /* (p, s) char *p; int s; */ ++/* alloc.c:480:OF */ extern void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */ + /* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p, int s); /* (p, s) char *p; int s; */ + /* alloc.c:611:OF */ extern void set_maxpage (void); /* () */ + /* alloc.c:635:OF */ extern void gcl_init_alloc (void *); /* () */ +@@ -124,6 +124,7 @@ struct key {short n,allow_other_keys; + /* cfun.c:299:OF */ extern object make_si_sfun_internal (char *s, object (*f)(), int argd); /* (s, f, argd) char *s; int (*f)(); int argd; */ + /* cfun.c:322:OF */ extern object make_si_function_internal (char *s, void (*f) ()); /* (s, f) char *s; int (*f)(); */ + /* cfun.c:341:OF */ extern object make_special_form_internal (char *s, void (*f)()); /* (s, f) char *s; int (*f)(); */ ++/* cfun.c:341:OF */ extern object make_si_special_form_internal (char *s, void (*f)()); /* (s, f) char *s; int (*f)(); */ + /* cfun.c:352:OF */ extern object fScompiled_function_name (object fun); /* (fun) object fun; */ + /* cfun.c:371:OF */ extern void turbo_closure (object fun); /* (fun) object fun; */ + /* cfun.c:392:OF */ extern object fSturbo_closure (object funobj); /* (funobj) object funobj; */ +@@ -467,7 +468,7 @@ typedef void (*funcvoid)(void); + /* regexp.c:1588:OF */ extern void regerror (char *s); /* (s) char *s; */ + /* regexpr.c:48:OF */ extern object fSmatch_beginning (fixnum i); /* (i) int i; */ + /* regexpr.c:57:OF */ extern object fSmatch_end (fixnum i); /* (i) int i; */ +-/* save.c:17:OF */ extern void Lsave (void); /* () */ ++/* save.c:17:OF */ extern void siLsave (void); /* () */ + #include + /* sbrk.c:9:OF */ /* extern void * sbrk (int n); */ /* (n) int n; */ + /* strcspn.c:3:OF */ /* extern size_t strcspn (const char *s1, const char *s2); */ /* (s1, s2) char *s1; char *s2; */ +@@ -862,9 +863,6 @@ void + Lstandard_char_p(void); + + void +-Lstring_char_p(void); +- +-void + Lchar_code(void); + + void +@@ -955,9 +953,6 @@ void + Lstandard_char_p(void); + + void +-Lstring_char_p(void); +- +-void + Lcharacter(void); + + void +@@ -1405,7 +1400,6 @@ void Lforce_output(void); + void Lnthcdr(void); + void Llogior(void); + void Lchar_downcase(void); +-void Lstring_char_p(void); + void Lstream_element_type(void); + void Lpackage_used_by_list(void); + void Ldivide(void); +@@ -1923,3 +1917,21 @@ rl_stream_p(FILE *f); + + void + sigint(void); ++ ++void ++allocate_code_block_reserve(void); ++ ++inline void ++resize_hole(ufixnum,enum type); ++ ++inline void * ++alloc_contblock_no_gc(size_t); ++ ++inline void ++reset_contblock_freelist(void); ++ ++inline void ++empty_relblock(void); ++ ++fixnum ++check_avail_pages(void); +--- gcl-2.6.12.orig/h/symbol.h ++++ gcl-2.6.12/h/symbol.h +@@ -23,6 +23,6 @@ object sLquote; + + object sLlambda; + +-object sLlambda_block; +-object sLlambda_closure; +-object sLlambda_block_closure; ++object sSlambda_block; ++object sSlambda_closure; ++object sSlambda_block_closure; +--- gcl-2.6.12.orig/h/writable.h ++++ gcl-2.6.12/h/writable.h +@@ -1,11 +1,16 @@ ++EXTER fixnum last_page; ++EXTER int last_result; ++ + EXTER inline int +-set_writable(fixnum i,fixnum m) { ++set_writable(fixnum i,bool m) { + + fixnum j; + object v; + +- if (i=page(core_end)) +- error("out of core in set_writable"); ++ last_page=last_result=0; ++ ++ if (i=page(heap_end)) ++ error("out of heap in set_writable"); + + if ((v=sSAwritableA ? sSAwritableA->s.s_dbind : Cnil)==Cnil) + error("no wrimap in set_writable"); +@@ -16,13 +21,13 @@ set_writable(fixnum i,fixnum m) { + if ((void *)wrimap!=(void *)v->v.v_self) + error("set_writable called in gc"); + ++ writable_pages+=m-((wrimap[j/8]>>(j%8))&0x1); ++ + if (m) + wrimap[j/8]|=(1<<(j%8)); + else + wrimap[j/8]&=~(1<<(j%8)); + +- writable_pages+=m ? 1 : -1; +- + return 0; + + } +@@ -35,13 +40,24 @@ is_writable(fixnum i) { + + if (i=page(core_end)) + return 0; +- ++ + if ((v=sSAwritableA ? sSAwritableA->s.s_dbind : Cnil)==Cnil) + return 1; +- ++ + if ((j=i-first_data_page)<0 || j>=v->v.v_dim) + return 1; +- ++ + return (wrimap[j/8]>>(j%8))&0x1; ++ ++} ++ ++EXTER inline int ++is_writable_cached(fixnum i) { ++ ++ if (last_page==i) ++ return last_result; ++ ++ last_page=i; ++ return last_result=is_writable(i); + + } +--- gcl-2.6.12.orig/info/form.texi ++++ gcl-2.6.12/info/form.texi +@@ -8,18 +8,6 @@ List of all the lambda-list keywords use + + @end defvr + +-@defun GET-SETF-METHOD (form) +-Package:LISP +- +-Returns the five values (or five 'gangs') constituting the SETF method for +-FORM. See the doc of DEFINE-SETF-METHOD for the meanings of the gangs. It +-is an error if the third value (i.e., the list of store variables) is not a +-one-element list. See the doc of GET-SETF-METHOD-MULTIPLE-VALUE for +-comparison. +- +- +-@end defun +- + @deffn {Special Form} THE + Package:LISP + +--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp ++++ gcl-2.6.12/lsp/gcl_arraylib.lsp +@@ -22,23 +22,7 @@ + ;;;; array routines + + +-(in-package 'lisp) +- +- +-(export '(make-array array-displacement vector +- array-element-type array-rank array-dimension +- array-dimensions +- array-in-bounds-p array-row-major-index +- adjustable-array-p +- bit sbit +- bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor +- bit-andc1 bit-andc2 bit-orc1 bit-orc2 bit-not +- array-has-fill-pointer-p fill-pointer +- vector-push vector-push-extend vector-pop +- adjust-array upgraded-array-element-type)) +- +-(in-package 'system) +- ++(in-package :si) + + (proclaim '(optimize (safety 2) (space 3))) + +@@ -47,7 +31,7 @@ + (or (gethash type *baet-hash*) + (setf (gethash type *baet-hash*) + (if type +- (car (member type '(string-char bit signed-char unsigned-char signed-short unsigned-short ++ (car (member type '(character bit signed-char unsigned-char signed-short unsigned-short + fixnum short-float long-float t) + :test 'subtypep)) t))))) + +--- gcl-2.6.12.orig/lsp/gcl_auto.lsp ++++ gcl-2.6.12/lsp/gcl_auto.lsp +@@ -1,4 +1,4 @@ +-(in-package 'si) ++(in-package :si) + ;;; Autoloaders. + + +--- gcl-2.6.12.orig/lsp/gcl_auto_new.lsp ++++ gcl-2.6.12/lsp/gcl_auto_new.lsp +@@ -1,4 +1,4 @@ +-(in-package 'si) ++(in-package :si) + ;;; Autoloaders. + + +@@ -67,8 +67,7 @@ + (autoload 'ftruncate '|gcl_numlib|) + #-unix (autoload 'get-decoded-time '|gcl_mislib|) + #+aosvs (autoload 'get-universal-time '|gcl_mislib|) +-(autoload 'get-setf-method '|gcl_setf|) +-(autoload 'get-setf-method-multiple-value '|gcl_setf|) ++(autoload 'get-setf-expansion '|gcl_setf|) + (autoload 'inspect '|gcl_describe|) + (autoload 'intersection '|gcl_listlib|) + (autoload 'isqrt '|gcl_numlib|) +--- gcl-2.6.12.orig/lsp/gcl_autoload.lsp ++++ gcl-2.6.12/lsp/gcl_autoload.lsp +@@ -21,8 +21,9 @@ + ;;;; AUTOLOAD + + +-;;; Go into LISP. +-(in-package 'lisp) ++(in-package :si) ++ ++(export '(clines defentry defcfun object void int double)) + + ;(defvar *features*) + +@@ -127,13 +128,13 @@ + + ;;; Allocator. + +-(import 'si::allocate) +-(export '(allocate ++;(import 'si::allocate) ++;(export '(allocate + ;allocated-pages maximum-allocatable-pages + ;allocate-contiguous-pages + ;allocated-contiguous-pages maximum-contiguous-pages + ;allocate-relocatable-pages allocated-relocatable-pages +- sfun gfun cfun cclosure spice structure)) ++; sfun gfun cfun cclosure spice structure)) + + ;(defvar type-character-alist + ; '((cons . #\.) +@@ -279,12 +280,12 @@ + ncbpage maxcbpage (if (zerop cbgbccount) nil cbgbccount) ncb) + (format t "~9T~D~35Thole~%" holepage) + (format t "~8D/~D~19T~6,1F%~@[~8D~]~35Trelocatable~%~%" +- nrbpage maxrbpage (/ rbused 0.01 (+ rbused rbfree)) ++ nrbpage maxrbpage (if (zerop (+ rbused rbfree)) 0.0 (/ rbused 0.01 (+ rbused rbfree))) + (if (zerop rbgbccount) nil rbgbccount)) + (format t "~10D pages for cells~%~%" npage) + (format t "~10D total pages in core~%" (+ npage ncbpage nrbpage)) + (format t "~10D current core maximum pages~%" (+ maxnpage maxcbpage maxrbpage)) +- (format t "~10D pages reserved for gc~%" maxrbpage) ++ (format t "~10D pages reserved for gc~%" nrbpage) + (format t "~10D pages available for adding to core~%" leftpage) + (format t "~10D pages reserved for core exhaustion~%~%" (- maxpage (+ maxnpage maxcbpage (ash maxrbpage 1) leftpage))) + (format t "~10D maximum pages~%" maxpage) +@@ -411,8 +412,8 @@ Good luck! The GCL Development Team" + (setf (get 'with-output-to-string 'si:pretty-print-format) 1) + + +-(in-package 'si) ++(in-package :si) + + (defvar *lib-directory* (namestring (truename "../"))) + +-(import '(*lib-directory* *load-path* *system-directory*) 'si::user) ++(import '(*lib-directory* *load-path* *system-directory*) :user) +--- gcl-2.6.12.orig/lsp/gcl_debug.lsp ++++ gcl-2.6.12/lsp/gcl_debug.lsp +@@ -1,8 +1,8 @@ + ;;Copyright William F. Schelter 1990, All Rights Reserved + + +-(In-package "SYSTEM") +-(import 'sloop::sloop) ++(In-package :si) ++(import '(sloop::sloop)) + + (eval-when (compile eval) + (proclaim '(optimize (safety 2) (space 3))) +@@ -98,7 +98,7 @@ + (cond ((compiled-function-p fun) + (setq name (compiled-function-name fun))) + (t (setq name fun))) +- (if (symbolp name)(setq args (get name 'debug))) ++ (if (symbolp name)(setq args (get name 'debugger))) + (let ((next (ihs-vs (f + 1 *current-ihs*)))) + (cond (next + (format *debug-io* ">> ~a():" name) +@@ -583,7 +583,7 @@ + ;; in other common lisps this should be a string output stream. + + (defvar *display-string* +- (make-array 100 :element-type 'string-char :fill-pointer 0 :adjustable t)) ++ (make-array 100 :element-type 'character :fill-pointer 0 :adjustable t)) + + (defun display-env (n env) + (do ((v (reverse env) (cdr v))) +@@ -625,7 +625,7 @@ + (mv-values nil j)) + (let + ((na (ihs-fname j))) +- (cond ((special-form-p na)) ++ (cond ((special-operator-p na)) + ((get na 'dbl-invisible)) + ((fboundp na)(return (mv-values na j))))))) + +@@ -677,7 +677,7 @@ + (vs (1+ k)) + (vs (+ k 2))) + ))))))) +- ((special-form-p na) nil) ++ ((special-operator-p na) nil) + ((get na 'dbl-invisible)) + ((fboundp na) + (mv-values i na nil nil +@@ -717,7 +717,7 @@ + (end (min (ihs-vs (1+ ihs)) (vs-top)))) + (format *display-string* "") + (do ((i base ) +- (v (get (ihs-fname ihs) 'debug) (cdr v))) ++ (v (get (ihs-fname ihs) 'debugger) (cdr v))) + ((or (fb >= i end)(fb > (fill-pointer *display-string*) plength))) + (format *display-string* "~a~@[~d~]=~s~@[,~]" + (or (car v) 'loc) (if (not (car v)) (f - i base)) (vs i) +--- gcl-2.6.12.orig/lsp/gcl_defmacro.lsp ++++ gcl-2.6.12/lsp/gcl_defmacro.lsp +@@ -22,11 +22,7 @@ + ;;;; defines SI:DEFMACRO*, the defmacro preprocessor + + +-(in-package 'lisp) +-(export '(&whole &environment &body)) +- +- +-(in-package 'system) ++(in-package :si) + + + (eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) +--- gcl-2.6.12.orig/lsp/gcl_defstruct.lsp ++++ gcl-2.6.12/lsp/gcl_defstruct.lsp +@@ -22,21 +22,13 @@ + ;;;; The structure routines. + + +-(in-package 'lisp) +-(export 'defstruct) +- +- +-(in-package 'system) ++(in-package :si) + + + (proclaim '(optimize (safety 2) (space 3))) + + + +-;(in-package 'system) +- +- +- + (defvar *accessors* (make-array 10 :adjustable t)) + (defvar *list-accessors* (make-array 2 :adjustable t)) + (defvar *vector-accessors* (make-array 2 :adjustable t)) +@@ -99,7 +91,10 @@ + (setq dont-overwrite t) + ) + (t (setf (get access-function 'structure-access) +- (cons (if type type name) offset))))))) ++ (cons (if type type name) offset)) ++ (when slot-type ++ (proclaim `(ftype (function (,name) ,slot-type) ,access-function))) ++ ))))) + nil)) + + +@@ -504,7 +499,7 @@ + ;bootstrapping code! + (setq def (make-s-data-structure + (make-array (* leng (size-of t)) +- :element-type 'string-char :static t) ++ :element-type 'character :static t) + (make-t-type leng nil slot-descriptions) + *standard-slot-positions* + slot-descriptions +@@ -569,9 +564,7 @@ + (setf (symbol-function predicate) + #'(lambda (x) + (si::structure-subtype-p x name)))) +- (setf (get predicate 'compiler::co1) +- 'compiler::co1structure-predicate) +- (setf (get predicate 'struct-predicate) name) ++ (proclaim `(ftype (function (,name) t) ,predicate));FIXME boolean is unboxed + ) + ) nil) + +--- gcl-2.6.12.orig/lsp/gcl_describe.lsp ++++ gcl-2.6.12/lsp/gcl_describe.lsp +@@ -22,12 +22,7 @@ + ;;;; DESCRIBE and INSPECT + + +-(in-package 'lisp) +- +-(export '(describe inspect)) +- +- +-(in-package 'system) ++(in-package :si) + + + (proclaim '(optimize (safety 2) (space 3))) +@@ -191,7 +186,6 @@ + (defun inspect-character (character) + (format t + (cond ((standard-char-p character) "~S - standard character") +- ((string-char-p character) "~S - string character") + (t "~S - character")) + character) + (inspect-print "code: #x~X" (char-code character)) +@@ -353,7 +347,7 @@ + (find-package "SYSTEM") + *package*))) + +- (cond ((special-form-p symbol) ++ (cond ((special-operator-p symbol) + (doc1 (or (documentation symbol 'function) "") + (if (macro-function symbol) + "[Special form and Macro]" +--- gcl-2.6.12.orig/lsp/gcl_destructuring_bind.lsp ++++ gcl-2.6.12/lsp/gcl_destructuring_bind.lsp +@@ -8,9 +8,7 @@ + ;;; in DEFMACRO are the reason this isn't as easy as it sounds. + ;;; + +-(in-package 'lisp) +- +-(export '(destructuring-bind)) ++(in-package :si) + + (defvar *arg-tests* () + "A list of tests that do argument counting at expansion time.") +--- gcl-2.6.12.orig/lsp/gcl_doc-file.lsp ++++ gcl-2.6.12/lsp/gcl_doc-file.lsp +@@ -13,7 +13,7 @@ + for w in-package v + when (setq doc (documentation w 'function)) + do (format st "F~a~%~ain ~a package:~a" w +- (cond ((special-form-p w) "Special Form ") ++ (cond ((special-operator-p w) "Special Form ") + ((functionp w) "Function ") + ((macro-function w) "Macro ") + (t "")) +--- gcl-2.6.12.orig/lsp/gcl_evalmacros.lsp ++++ gcl-2.6.12/lsp/gcl_evalmacros.lsp +@@ -20,11 +20,7 @@ + ;;;; evalmacros.lsp + + +-(in-package "LISP") +- +-(export '(defvar defparameter defconstant)) +- +-(in-package "SYSTEM") ++(in-package :si) + + + (eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) +--- gcl-2.6.12.orig/lsp/gcl_export.lsp ++++ gcl-2.6.12/lsp/gcl_export.lsp +@@ -21,313 +21,468 @@ + ;;;; + ;;;; Exporting external symbols of LISP package + +- +-(in-package 'lisp) +- ++(in-package :common-lisp) + + (export '( +- +-&whole +-&environment +-&body +-* +-** +-*** +-*break-enable* +-*break-on-warnings* +-*features* +-*modules* +-+ +-++ +-+++ +-- +-/ +-// +-/// +-COMMON +-KYOTO +-KCL +-abs +-acos +-acosh +-adjust-array +-adjustable-array-p +-apropos +-apropos-list +-array-dimension +-array-dimensions +-array-element-type +-array-has-fill-pointer-p +-array-in-bounds-p +-array-rank +-array-row-major-index +-asin +-asinh +-assert +-atanh +-bit +-bit-and +-bit-andc1 +-bit-andc2 +-bit-eqv +-bit-ior +-bit-nand +-bit-nor +-bit-not +-bit-orc1 +-bit-orc2 +-bit-xor +-break +-byte +-byte-position +-byte-size +-ccase +-cerror +-check-type +-cis +-coerce +-compile +-compile-file +-concatenate +-cosh +-count +-count-if +-count-if-not +-ctypecase +-decf +-declaim +-decode-universal-time +-defconstant +-define-modify-macro +-define-setf-method +-defparameter +-defsetf +-defstruct +-deftype +-defvar +-delete +-delete-duplicates +-delete-if +-delete-if-not +-deposit-field +-describe +-disassemble +-do* +-do-all-symbols +-do-external-symbols +-do-symbols +-documentation +-dolist +-dotimes +-dpb +-dribble +-ecase +-ed +-eighth +-encode-universal-time +-error +-etypecase +-eval-when +-every +-fceiling +-ffloor +-fifth +-fill +-fill-pointer +-find +-find-all-symbols +-find-if +-find-if-not +-first +-format +-fourth +-fround +-ftruncate +-get-decoded-time +-get-setf-method +-get-setf-method-multiple-value +-get-universal-time +-getf +-ignore +-ignorable +-incf +-inspect +-intersection +-isqrt +-ldb +-ldb-test +-lisp-implementation-type +-logandc1 +-logandc2 +-lognand +-lognor +-lognot +-logorc1 +-logorc2 +-logtest +-long-site-name +-machine-instance +-machine-type +-machine-version +-make-array +-make-sequence +-map +-mask-field +-merge +-mismatch +-mod +-multiple-value-setq +-nintersection +-ninth +-notany +-notevery +-nset-difference +-nset-exclusive-or +-nsubstitute +-nsubstitute-if +-nsubstitute-if-not +-nunion +-phase +-pop +-position +-position-if +-position-if-not +-prin1-to-string +-princ-to-string +-prog* +-provide +-psetf +-push +-pushnew +-rational +-rationalize +-real +-read-from-string +-reduce +-rem +-remf +-remove +-remove-duplicates +-remove-if +-remove-if-not +-replace +-require +-rotatef +-room +-sbit +-search +-second +-set-difference +-set-exclusive-or +-setf +-seventh +-shiftf +-short-site-name +-signum +-sinh +-sixth +-software-type +-software-version +-some +-sort +-stable-sort +-step +-structure +-subsetp +-substitute +-substitute-if +-substitute-if-not +-subtypep +-tanh +-tenth +-third +-time +-trace +-type +-typecase +-typep +-union +-untrace +-variable +-vector +-vector-pop +-vector-push +-vector-push-extend +-warn +-with-input-from-string +-with-open-file +-with-open-stream +-with-output-to-string +-write-to-string +-y-or-n-p +-yes-or-no-p +- +-proclaim +-proclamation +-special +-type +-ftype +-function +-inline +-notinline +-ignore +-optimize +-speed +-space +-safety +-compilation-speed +-declaration +- +-*eval-when-compile* +- +-clines +-defcfun +-defentry +-defla +- +-void +-object +-char +-int +-float +-double +- +-define-compiler-macro +-compiler-macro +-compiler-macro-function +- +-with-compilation-unit +-with-standard-io-syntax +-*print-lines* +-*print-miser-width* +-*print-pprint-dispatch* +-*print-right-margin* +- +-*read-eval* +- +-dynamic-extent +- +-loop +-check-type assert typecase etypecase ctypecase case ecase ccase +- +-restart-bind restart-case with-condition-restarts muffle-warning continue abort +- store-value use-value +- restart restart-name restart-function restart-report-function +- restart-interactive-function restart-test-function +- compute-restarts find-restart invoke-restart invoke-restart-interactively +- with-simple-restart signal +- +-simple-condition simple-error simple-warning invoke-debugger *debugger-hook* *break-on-signals* +- +-handler-case handler-bind ignore-errors define-condition make-condition +- condition warning serious-condition simple-condition-format-control simple-condition-format-arguments +- storage-condition stack-overflow storage-exhausted type-error +- type-error-datum type-error-expected-type simple-type-error +- program-error control-error stream-error stream-error-stream +- end-of-file file-error file-error-pathname cell-error cell-error-name +- unbound-variable undefined-function arithmetic-error +- arithmetic-error-operation arithmetic-error-operands +- package-error package-error-package +- division-by-zero floating-point-overflow floating-point-underflow +- +-)) ++ &allow-other-keys *print-miser-width* ++ &aux *print-pprint-dispatch* ++ &body *print-pretty* ++ &environment *print-radix* ++ &key *print-readably* ++ &optional *print-right-margin* ++ &rest *query-io* ++ &whole *random-state* ++ * *read-base* ++ ** *read-default-float-format* ++ *** *read-eval* ++ *break-on-signals* *read-suppress* ++ *compile-file-pathname* *readtable* ++ *compile-file-truename* *standard-input* ++ *compile-print* *standard-output* ++ *compile-verbose* *terminal-io* ++ *debug-io* *trace-output* ++ *debugger-hook* + ++ *default-pathname-defaults* ++ ++ *error-output* +++ ++ *features* - ++ *gensym-counter* / ++ *load-pathname* // ++ *load-print* /// ++ *load-truename* /= ++ *load-verbose* 1+ ++ *macroexpand-hook* 1- ++ *modules* < ++ *package* <= ++ *print-array* = ++ *print-base* > ++ *print-case* >= ++ *print-circle* abort ++ *print-escape* abs ++ *print-gensym* acons ++ *print-length* acos ++ *print-level* acosh ++ *print-lines* add-method ++ ++ adjoin atom boundp ++ adjust-array base-char break ++ adjustable-array-p base-string broadcast-stream ++ allocate-instance bignum broadcast-stream-streams ++ alpha-char-p bit built-in-class ++ alphanumericp bit-and butlast ++ and bit-andc1 byte ++ append bit-andc2 byte-position ++ apply bit-eqv byte-size ++ apropos bit-ior caaaar ++ apropos-list bit-nand caaadr ++ aref bit-nor caaar ++ arithmetic-error bit-not caadar ++ arithmetic-error-operands bit-orc1 caaddr ++ arithmetic-error-operation bit-orc2 caadr ++ array bit-vector caar ++ array-dimension bit-vector-p cadaar ++ array-dimension-limit bit-xor cadadr ++ array-dimensions block cadar ++ array-displacement boole caddar ++ array-element-type boole-1 cadddr ++ array-has-fill-pointer-p boole-2 caddr ++ array-in-bounds-p boole-and cadr ++ array-rank boole-andc1 call-arguments-limit ++ array-rank-limit boole-andc2 call-method ++ array-row-major-index boole-c1 call-next-method ++ array-total-size boole-c2 car ++ array-total-size-limit boole-clr case ++ arrayp boole-eqv catch ++ ash boole-ior ccase ++ asin boole-nand cdaaar ++ asinh boole-nor cdaadr ++ assert boole-orc1 cdaar ++ assoc boole-orc2 cdadar ++ assoc-if boole-set cdaddr ++ assoc-if-not boole-xor cdadr ++ atan boolean cdar ++ atanh both-case-p cddaar ++ ++ cddadr clear-input copy-tree ++ cddar clear-output cos ++ cdddar close cosh ++ cddddr clrhash count ++ cdddr code-char count-if ++ cddr coerce count-if-not ++ cdr compilation-speed ctypecase ++ ceiling compile debug ++ cell-error compile-file decf ++ cell-error-name compile-file-pathname declaim ++ cerror compiled-function declaration ++ change-class compiled-function-p declare ++ char compiler-macro decode-float ++ char-code compiler-macro-function decode-universal-time ++ char-code-limit complement defclass ++ char-downcase complex defconstant ++ char-equal complexp defgeneric ++ char-greaterp compute-applicable-methods define-compiler-macro ++ char-int compute-restarts define-condition ++ char-lessp concatenate define-method-combination ++ char-name concatenated-stream define-modify-macro ++ char-not-equal concatenated-stream-streams define-setf-expander ++ char-not-greaterp cond define-symbol-macro ++ char-not-lessp condition defmacro ++ char-upcase conjugate defmethod ++ char/= cons defpackage ++ char< consp defparameter ++ char<= constantly defsetf ++ char= constantp defstruct ++ char> continue deftype ++ char>= control-error defun ++ character copy-alist defvar ++ characterp copy-list delete ++ check-type copy-pprint-dispatch delete-duplicates ++ cis copy-readtable delete-file ++ class copy-seq delete-if ++ class-name copy-structure delete-if-not ++ class-of copy-symbol delete-package ++ ++ denominator eq ++ deposit-field eql ++ describe equal ++ describe-object equalp ++ destructuring-bind error ++ digit-char etypecase ++ digit-char-p eval ++ directory eval-when ++ directory-namestring evenp ++ disassemble every ++ division-by-zero exp ++ do export ++ do* expt ++ do-all-symbols extended-char ++ do-external-symbols fboundp ++ do-symbols fceiling ++ documentation fdefinition ++ dolist ffloor ++ dotimes fifth ++ double-float file-author ++ double-float-epsilon file-error ++ double-float-negative-epsilon file-error-pathname ++ dpb file-length ++ dribble file-namestring ++ dynamic-extent file-position ++ ecase file-stream ++ echo-stream file-string-length ++ echo-stream-input-stream file-write-date ++ echo-stream-output-stream fill ++ ed fill-pointer ++ eighth find ++ elt find-all-symbols ++ encode-universal-time find-class ++ end-of-file find-if ++ endp find-if-not ++ enough-namestring find-method ++ ensure-directories-exist find-package ++ ensure-generic-function find-restart ++ ++ find-symbol get-internal-run-time ++ finish-output get-macro-character ++ first get-output-stream-string ++ fixnum get-properties ++ flet get-setf-expansion ++ float get-universal-time ++ float-digits getf ++ float-precision gethash ++ float-radix go ++ float-sign graphic-char-p ++ floating-point-inexact handler-bind ++ floating-point-invalid-operation handler-case ++ floating-point-overflow hash-table ++ floating-point-underflow hash-table-count ++ floatp hash-table-p ++ floor hash-table-rehash-size ++ fmakunbound hash-table-rehash-threshold ++ force-output hash-table-size ++ format hash-table-test ++ formatter host-namestring ++ fourth identity ++ fresh-line if ++ fround ignorable ++ ftruncate ignore ++ ftype ignore-errors ++ funcall imagpart ++ function import ++ function-keywords in-package ++ function-lambda-expression incf ++ functionp initialize-instance ++ gcd inline ++ generic-function input-stream-p ++ gensym inspect ++ gentemp integer ++ get integer-decode-float ++ get-decoded-time integer-length ++ get-dispatch-macro-character integerp ++ get-internal-real-time interactive-stream-p ++ ++ intern lisp-implementation-type ++ internal-time-units-per-second lisp-implementation-version ++ intersection list ++ invalid-method-error list* ++ invoke-debugger list-all-packages ++ invoke-restart list-length ++ invoke-restart-interactively listen ++ isqrt listp ++ keyword load ++ keywordp load-logical-pathname-translations ++ labels load-time-value ++ lambda locally ++ lambda-list-keywords log ++ lambda-parameters-limit logand ++ last logandc1 ++ lcm logandc2 ++ ldb logbitp ++ ldb-test logcount ++ ldiff logeqv ++ least-negative-double-float logical-pathname ++ least-negative-long-float logical-pathname-translations ++ least-negative-normalized-double-float logior ++ least-negative-normalized-long-float lognand ++ least-negative-normalized-short-float lognor ++ least-negative-normalized-single-float lognot ++ least-negative-short-float logorc1 ++ least-negative-single-float logorc2 ++ least-positive-double-float logtest ++ least-positive-long-float logxor ++ least-positive-normalized-double-float long-float ++ least-positive-normalized-long-float long-float-epsilon ++ least-positive-normalized-short-float long-float-negative-epsilon ++ least-positive-normalized-single-float long-site-name ++ least-positive-short-float loop ++ least-positive-single-float loop-finish ++ length lower-case-p ++ let machine-instance ++ let* machine-type ++ ++ machine-version mask-field ++ macro-function max ++ macroexpand member ++ macroexpand-1 member-if ++ macrolet member-if-not ++ make-array merge ++ make-broadcast-stream merge-pathnames ++ make-concatenated-stream method ++ make-condition method-combination ++ make-dispatch-macro-character method-combination-error ++ make-echo-stream method-qualifiers ++ make-hash-table min ++ make-instance minusp ++ make-instances-obsolete mismatch ++ make-list mod ++ make-load-form most-negative-double-float ++ make-load-form-saving-slots most-negative-fixnum ++ make-method most-negative-long-float ++ make-package most-negative-short-float ++ make-pathname most-negative-single-float ++ make-random-state most-positive-double-float ++ make-sequence most-positive-fixnum ++ make-string most-positive-long-float ++ make-string-input-stream most-positive-short-float ++ make-string-output-stream most-positive-single-float ++ make-symbol muffle-warning ++ make-synonym-stream multiple-value-bind ++ make-two-way-stream multiple-value-call ++ makunbound multiple-value-list ++ map multiple-value-prog1 ++ map-into multiple-value-setq ++ mapc multiple-values-limit ++ mapcan name-char ++ mapcar namestring ++ mapcon nbutlast ++ maphash nconc ++ mapl next-method-p ++ maplist nil ++ ++ nintersection package-error ++ ninth package-error-package ++ no-applicable-method package-name ++ no-next-method package-nicknames ++ not package-shadowing-symbols ++ notany package-use-list ++ notevery package-used-by-list ++ notinline packagep ++ nreconc pairlis ++ nreverse parse-error ++ nset-difference parse-integer ++ nset-exclusive-or parse-namestring ++ nstring-capitalize pathname ++ nstring-downcase pathname-device ++ nstring-upcase pathname-directory ++ nsublis pathname-host ++ nsubst pathname-match-p ++ nsubst-if pathname-name ++ nsubst-if-not pathname-type ++ nsubstitute pathname-version ++ nsubstitute-if pathnamep ++ nsubstitute-if-not peek-char ++ nth phase ++ nth-value pi ++ nthcdr plusp ++ null pop ++ number position ++ numberp position-if ++ numerator position-if-not ++ nunion pprint ++ oddp pprint-dispatch ++ open pprint-exit-if-list-exhausted ++ open-stream-p pprint-fill ++ optimize pprint-indent ++ or pprint-linear ++ otherwise pprint-logical-block ++ output-stream-p pprint-newline ++ package pprint-pop ++ ++ pprint-tab read-char ++ pprint-tabular read-char-no-hang ++ prin1 read-delimited-list ++ prin1-to-string read-from-string ++ princ read-line ++ princ-to-string read-preserving-whitespace ++ print read-sequence ++ print-not-readable reader-error ++ print-not-readable-object readtable ++ print-object readtable-case ++ print-unreadable-object readtablep ++ probe-file real ++ proclaim realp ++ prog realpart ++ prog* reduce ++ prog1 reinitialize-instance ++ prog2 rem ++ progn remf ++ program-error remhash ++ progv remove ++ provide remove-duplicates ++ psetf remove-if ++ psetq remove-if-not ++ push remove-method ++ pushnew remprop ++ quote rename-file ++ random rename-package ++ random-state replace ++ random-state-p require ++ rassoc rest ++ rassoc-if restart ++ rassoc-if-not restart-bind ++ ratio restart-case ++ rational restart-name ++ rationalize return ++ rationalp return-from ++ read revappend ++ read-byte reverse ++ ++ room simple-bit-vector ++ rotatef simple-bit-vector-p ++ round simple-condition ++ row-major-aref simple-condition-format-arguments ++ rplaca simple-condition-format-control ++ rplacd simple-error ++ safety simple-string ++ satisfies simple-string-p ++ sbit simple-type-error ++ scale-float simple-vector ++ schar simple-vector-p ++ search simple-warning ++ second sin ++ sequence single-float ++ serious-condition single-float-epsilon ++ set single-float-negative-epsilon ++ set-difference sinh ++ set-dispatch-macro-character sixth ++ set-exclusive-or sleep ++ set-macro-character slot-boundp ++ set-pprint-dispatch slot-exists-p ++ set-syntax-from-char slot-makunbound ++ setf slot-missing ++ setq slot-unbound ++ seventh slot-value ++ shadow software-type ++ shadowing-import software-version ++ shared-initialize some ++ shiftf sort ++ short-float space ++ short-float-epsilon special ++ short-float-negative-epsilon special-operator-p ++ short-site-name speed ++ signal sqrt ++ signed-byte stable-sort ++ signum standard ++ simple-array standard-char ++ simple-base-string standard-char-p ++ ++ standard-class sublis ++ standard-generic-function subseq ++ standard-method subsetp ++ standard-object subst ++ step subst-if ++ storage-condition subst-if-not ++ store-value substitute ++ stream substitute-if ++ stream-element-type substitute-if-not ++ stream-error subtypep ++ stream-error-stream svref ++ stream-external-format sxhash ++ streamp symbol ++ string symbol-function ++ string-capitalize symbol-macrolet ++ string-downcase symbol-name ++ string-equal symbol-package ++ string-greaterp symbol-plist ++ string-left-trim symbol-value ++ string-lessp symbolp ++ string-not-equal synonym-stream ++ string-not-greaterp synonym-stream-symbol ++ string-not-lessp t ++ string-right-trim tagbody ++ string-stream tailp ++ string-trim tan ++ string-upcase tanh ++ string/= tenth ++ string< terpri ++ string<= the ++ string= third ++ string> throw ++ string>= time ++ stringp trace ++ structure translate-logical-pathname ++ structure-class translate-pathname ++ structure-object tree-equal ++ style-warning truename ++ ++ truncate values-list ++ two-way-stream variable ++ two-way-stream-input-stream vector ++ two-way-stream-output-stream vector-pop ++ type vector-push ++ type-error vector-push-extend ++ type-error-datum vectorp ++ type-error-expected-type warn ++ type-of warning ++ typecase when ++ typep wild-pathname-p ++ unbound-slot with-accessors ++ unbound-slot-instance with-compilation-unit ++ unbound-variable with-condition-restarts ++ undefined-function with-hash-table-iterator ++ unexport with-input-from-string ++ unintern with-open-file ++ union with-open-stream ++ unless with-output-to-string ++ unread-char with-package-iterator ++ unsigned-byte with-simple-restart ++ untrace with-slots ++ unuse-package with-standard-io-syntax ++ unwind-protect write ++ update-instance-for-different-class write-byte ++ update-instance-for-redefined-class write-char ++ upgraded-array-element-type write-line ++ upgraded-complex-part-type write-sequence ++ upper-case-p write-string ++ use-package write-to-string ++ use-value y-or-n-p ++ user-homedir-pathname yes-or-no-p ++ values zerop)) +--- gcl-2.6.12.orig/lsp/gcl_fpe.lsp ++++ gcl-2.6.12/lsp/gcl_fpe.lsp +@@ -1,8 +1,8 @@ +-(in-package :fpe :use '(:lisp)) ++(in-package :fpe) + + (import 'si::(disassemble-instruction feenableexcept fedisableexcept fld *fixnum *float *double + +fe-list+ +mc-context-offsets+ floating-point-error +- function-by-address)) ++ function-by-address clines defentry)) + (export '(break-on-floating-point-exceptions read-instruction)) + + (eval-when +--- gcl-2.6.12.orig/lsp/gcl_info.lsp ++++ gcl-2.6.12/lsp/gcl_info.lsp +@@ -1,4 +1,4 @@ +-(in-package "SI" ) ++(in-package :si) + + (eval-when (compile eval) + (defmacro while (test &body body) +@@ -11,7 +11,7 @@ + (eval-when (compile eval load) + (defun sharp-u-reader (stream subchar arg) + subchar arg +- (let ((tem (make-array 10 :element-type 'string-char :fill-pointer 0))) ++ (let ((tem (make-array 10 :element-type 'character :fill-pointer 0))) + (or (eql (read-char stream) #\") + (error "sharp-u-reader reader needs a \" right after it")) + (loop +@@ -44,7 +44,7 @@ + (or (and (<= 0 start ) (<= start len)) + (error "illegal file start ~a" start)) + (let ((tem (make-array (- len start) +- :element-type 'string-char))) ++ :element-type 'character))) + (if (> start 0) (file-position st start)) + (si::fread tem 0 (length tem) st) tem))) + +@@ -105,7 +105,7 @@ + ((> extra 0) + (setq tem + (make-array (f + (length x) extra) +- :element-type 'string-char :fill-pointer 0)) ++ :element-type 'character :fill-pointer 0)) + (setq i 0) + (go AGAIN)) + (t (setq tem x))) +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -22,21 +22,7 @@ + ;;;; The IO library. + + +-(in-package 'lisp) +- +- +-(export '(with-open-stream with-input-from-string with-output-to-string +- ensure-directories-exist wild-pathname-p +- read-byte write-byte read-sequence write-sequence)) +-(export '(read-from-string)) +-(export '(write-to-string prin1-to-string princ-to-string)) +-(export 'with-open-file) +-(export '(y-or-n-p yes-or-no-p)) +-(export 'dribble) +- +- +-(in-package 'system) +- ++(in-package :si) + + (proclaim '(optimize (safety 2) (space 3))) + +--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp ++++ gcl-2.6.12/lsp/gcl_listlib.lsp +@@ -25,13 +25,7 @@ + ; rather than recursion, as needed for large data sets. + + +-(in-package 'lisp) +- +-(export '(union nunion intersection nintersection +- set-difference nset-difference set-exclusive-or nset-exclusive-or +- subsetp nth nth-value nthcdr first second third fourth fifth sixth seventh eighth ninth tenth)) +- +-(in-package 'system) ++(in-package :si) + + (eval-when (compile) + (proclaim '(optimize (safety 0) (space 3))) +--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp ++++ gcl-2.6.12/lsp/gcl_mislib.lsp +@@ -20,15 +20,7 @@ + ;;;; This file is IMPLEMENTATION-DEPENDENT. + + +-(in-package 'lisp) +- +- +-(export 'time) +-(export '(reset-sys-paths decode-universal-time encode-universal-time compile-file-pathname complement constantly)) +- +- +-(in-package 'system) +- ++(in-package :si) + + (proclaim '(optimize (safety 2) (space 3))) + +@@ -37,13 +29,13 @@ + (let ((real-start (gensym)) (real-end (gensym)) (gbc-time-start (gensym)) + (gbc-time (gensym)) (x (gensym)) (run-start (gensym)) (run-end (gensym)) + (child-run-start (gensym)) (child-run-end (gensym))) +- `(let (,real-start ,real-end (,gbc-time-start (si::gbc-time)) ,gbc-time ,x) ++ `(let (,real-start ,real-end (,gbc-time-start (gbc-time)) ,gbc-time ,x) + (setq ,real-start (get-internal-real-time)) + (multiple-value-bind (,run-start ,child-run-start) (get-internal-run-time) +- (si::gbc-time 0) ++ (gbc-time 0) + (setq ,x (multiple-value-list ,form)) +- (setq ,gbc-time (si::gbc-time)) +- (si::gbc-time (+ ,gbc-time-start ,gbc-time)) ++ (setq ,gbc-time (gbc-time)) ++ (gbc-time (+ ,gbc-time-start ,gbc-time)) + (multiple-value-bind (,run-end ,child-run-end) (get-internal-run-time) + (setq ,real-end (get-internal-real-time)) + (fresh-line *trace-output*) +@@ -139,7 +131,7 @@ x)) + *gcl-major-version* *gcl-minor-version* *gcl-extra-version* + (if (member :ansi-cl *features*) "ANSI" "CLtL1") + (if (member :gprof *features*) "profiling" "") +- (si::gcl-compile-time) ++ (gcl-compile-time) + "Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)" + "Binary License: " + (if gpled-modules (format nil "GPL due to GPL'ed components: ~a" gpled-modules) +@@ -150,13 +142,13 @@ x)) + + (defun lisp-implementation-version nil + (format nil "GCL ~a.~a.~a" +- si::*gcl-major-version* +- si::*gcl-minor-version* +- si::*gcl-extra-version*)) ++ *gcl-major-version* ++ *gcl-minor-version* ++ *gcl-extra-version*)) + + (defun objlt (x y) + (declare (object x y)) +- (let ((x (si::address x)) (y (si::address y))) ++ (let ((x (address x)) (y (address y))) + (declare (fixnum x y)) + (if (< y 0) + (if (< x 0) (< x y) t) +@@ -164,10 +156,10 @@ x)) + + (defun reset-sys-paths (s) + (declare (string s)) +- (setq si::*lib-directory* s) +- (setq si::*system-directory* (si::string-concatenate s "unixport/")) ++ (setq *lib-directory* s) ++ (setq *system-directory* (string-concatenate s "unixport/")) + (let (nl) + (dolist (l '("cmpnew/" "gcl-tk/" "lsp/" "xgcl-2/")) +- (push (si::string-concatenate s l) nl)) +- (setq si::*load-path* nl)) ++ (push (string-concatenate s l) nl)) ++ (setq *load-path* nl)) + nil) +--- gcl-2.6.12.orig/lsp/gcl_module.lsp ++++ gcl-2.6.12/lsp/gcl_module.lsp +@@ -22,13 +22,7 @@ + ;;;; module routines + + +-(in-package 'lisp) +- +-(export '(*modules* provide require)) +-(export 'documentation) +-(export '(variable function structure type setf)) +- +-(in-package 'system) ++(in-package :si) + + + (eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) +--- gcl-2.6.12.orig/lsp/gcl_numlib.lsp ++++ gcl-2.6.12/lsp/gcl_numlib.lsp +@@ -22,20 +22,7 @@ + ;;;; number routines + + +-(in-package 'lisp) +-(export +- '(isqrt abs phase signum cis asin acos sinh cosh tanh +- asinh acosh atanh +- rational rationalize +- ffloor fround ftruncate fceiling +- lognand lognor logandc1 logandc2 logorc1 logorc2 +- lognot logtest +- byte byte-size byte-position +- ldb ldb-test mask-field dpb deposit-field +- )) +- +- +-(in-package 'system) ++(in-package :si) + + + (proclaim '(optimize (safety 2) (space 3))) +--- gcl-2.6.12.orig/lsp/gcl_packlib.lsp ++++ gcl-2.6.12/lsp/gcl_packlib.lsp +@@ -22,14 +22,7 @@ + ;;;; package routines + + +-(in-package 'lisp) +- +- +-(export '(find-all-symbols do-symbols do-external-symbols do-all-symbols with-package-iterator)) +-(export '(apropos apropos-list)) +- +- +-(in-package 'system) ++(in-package :si) + + + (proclaim '(optimize (safety 2) (space 3))) +@@ -121,7 +114,7 @@ + (defun print-symbol-apropos (symbol) + (prin1 symbol) + (when (fboundp symbol) +- (if (special-form-p symbol) ++ (if (special-operator-p symbol) + (princ " Special form") + (if (macro-function symbol) + (princ " Macro") +--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.12/lsp/gcl_predlib.lsp +@@ -22,9 +22,7 @@ + ;;;; predicate routines + + +-(in-package 'system) +- +-(export '(lisp::deftype lisp::typep lisp::subtypep lisp::coerce) 'lisp) ++(in-package :si) + + (eval-when (compile) + (proclaim '(optimize (safety 2) (space 3))) +@@ -87,7 +85,7 @@ + (deftype vector (&optional element-type size) + `(array ,element-type (,size))) + (deftype string (&optional size) +- `(vector string-char ,size)) ++ `(vector character ,size)) + (deftype base-string (&optional size) + `(vector base-char ,size)) + (deftype bit-vector (&optional size) +@@ -96,7 +94,7 @@ + (deftype simple-vector (&optional size) + `(simple-array t (,size))) + (deftype simple-string (&optional size) +- `(simple-array string-char (,size))) ++ `(simple-array character (,size))) + (deftype simple-base-string (&optional size) + `(simple-array base-char (,size))) + (deftype simple-bit-vector (&optional size) +@@ -206,8 +204,8 @@ + (ratio (eq (type-of object) 'ratio)) + (standard-char + (and (characterp object) (standard-char-p object))) +- ((base-char string-char) +- (and (characterp object) (string-char-p object))) ++ ((base-char character) ++ (characterp object)) + (integer + (and (integerp object) (in-interval-p object i))) + (rational +@@ -309,7 +307,7 @@ + signed-char unsigned-char signed-short unsigned-short + number integer bignum rational ratio float method-combination + short-float single-float double-float long-float complex +- character standard-char string-char real ++ character standard-char character real + package stream pathname readtable hash-table random-state + structure array simple-array function compiled-function + arithmetic-error base-char base-string broadcast-stream +@@ -583,23 +581,23 @@ + (if (sub-interval-p '(* *) i2) (values t t) (values nil t))) + (t (values nil ntp2)))) + (standard-char +- (if (member t2 '(base-char string-char character)) ++ (if (member t2 '(base-char character character)) + (values t t) + (values nil ntp2))) + (base-char +- (if (member t2 '(character string-char)) ++ (if (member t2 '(character character)) + (values t t) + (values nil ntp2))) + (extended-char +- (if (member t2 '(character string-char)) ++ (if (member t2 '(character character)) + (values t t) + (values nil ntp2))) +- (string-char ++ (character + (if (eq t2 'character) + (values t t) + (values nil ntp2))) + (character +- (if (eq t2 'string-char) ++ (if (eq t2 'character) + (values t t) + (values nil ntp2))) + (integer +@@ -635,7 +633,7 @@ + (unless (or (equal (car i1) (car i2)) + ; FIXME + (and (eq (car i1) 'base-char) +- (eq (car i2) 'string-char))) ++ (eq (car i2) 'character))) + ;; Unless the element type matches, + ;; return NIL T. + ;; Is this too strict? +@@ -658,7 +656,7 @@ + (unless (or (equal (car i1) (car i2)) + ; FIXME + (and (eq (car i1) 'base-char) +- (eq (car i2) 'string-char))) ++ (eq (car i2) 'character))) + (return-from subtypep + (values nil t))))) + (when (or (endp (cdr i1)) (eq (cadr i1) '*)) +--- gcl-2.6.12.orig/lsp/gcl_profile.lsp ++++ gcl-2.6.12/lsp/gcl_profile.lsp +@@ -1,5 +1,5 @@ + +-(in-package 'si) ++(in-package :si) + (use-package "SLOOP") + + ;; Sample Usage: +--- gcl-2.6.12.orig/lsp/gcl_seq.lsp ++++ gcl-2.6.12/lsp/gcl_seq.lsp +@@ -22,11 +22,7 @@ + ;;;; sequence routines + + +-(in-package 'lisp) +- +-(export '(make-sequence concatenate map some every notany notevery)) +- +-(in-package 'system) ++(in-package :si) + + + (proclaim '(optimize (safety 2) (space 3))) +@@ -40,7 +36,7 @@ + (if iesp + (make-list size :initial-element initial-element) + (make-list size)))) +- ((or (eq type 'simple-string) (eq type 'string)) 'string-char) ++ ((or (eq type 'simple-string) (eq type 'string)) 'character) + ((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit) + ((or (eq type 'simple-vector) (eq type 'vector)) t) + (t +--- gcl-2.6.12.orig/lsp/gcl_seqlib.lsp ++++ gcl-2.6.12/lsp/gcl_seqlib.lsp +@@ -22,24 +22,7 @@ + ;;;; sequence routines + + +-(in-package 'lisp) +- +- +-(export '(reduce fill replace +- remove remove-if remove-if-not +- delete delete-if delete-if-not +- count count-if count-if-not +- substitute substitute-if substitute-if-not +- nsubstitute nsubstitute-if nsubstitute-if-not +- find find-if find-if-not +- position position-if position-if-not +- remove-duplicates delete-duplicates +- mismatch search +- with-hash-table-iterator +- sort stable-sort merge map-into)) +- +- +-(in-package 'system) ++(in-package :si) + + + (proclaim '(optimize (safety 2) (space 3))) +--- gcl-2.6.12.orig/lsp/gcl_serror.lsp ++++ gcl-2.6.12/lsp/gcl_serror.lsp +@@ -100,6 +100,8 @@ + args)))) + ("unknown error"))) + ++(defvar *break-on-warnings* nil) ++ + (defun warn (datum &rest arguments) + (declare (optimize (safety 2))) + (let ((c (process-error datum arguments 'simple-warning))) +--- gcl-2.6.12.orig/lsp/gcl_setf.lsp ++++ gcl-2.6.12/lsp/gcl_setf.lsp +@@ -22,16 +22,7 @@ + ;;;; setf routines + + +-(in-package 'lisp) +- +- +-(export '(setf psetf shiftf rotatef +- define-modify-macro defsetf +- getf remf incf decf push pushnew pop +- define-setf-method get-setf-method get-setf-method-multiple-value)) +- +- +-(in-package 'system) ++(in-package :si) + + + (eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) +@@ -86,10 +77,10 @@ + ',access-fn)) + + +-;;; GET-SETF-METHOD. ++;;; GET-SETF-EXPANSION. + ;;; It just calls GET-SETF-METHOD-MULTIPLE-VALUE + ;;; and checks the number of the store variable. +-(defun get-setf-method (form &optional env) ++(defun get-setf-expansion (form &optional env) + (multiple-value-bind (vars vals stores store-form access-form) + (get-setf-method-multiple-value form env) + (unless (= (list-length stores) 1) +@@ -218,7 +209,7 @@ + + (define-setf-method getf (&environment env place indicator &optional default) + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method place env) ++ (get-setf-expansion place env) + (let ((itemp (gensym)) (store (gensym))) + (values `(,@vars ,itemp) + `(,@vals ,indicator) +@@ -234,7 +225,7 @@ + + (define-setf-method the (&environment env type form) + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method form env) ++ (get-setf-expansion form env) + (let ((store (gensym))) + (values vars vals (list store) + `(let ((,(car stores) (the ,type ,store))) ,store-form) +@@ -246,7 +237,7 @@ + (null (cddr fn))) + (error "Can't get the setf-method of ~S." fn)) + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method (cons (cadr fn) rest) env) ++ (get-setf-expansion (cons (cadr fn) rest) env) + (unless (eq (car (last store-form)) (car (last vars))) + (error "Can't get the setf-method of ~S." fn)) + (values vars vals stores +@@ -261,7 +252,7 @@ + (null (cddr fn))) + (error "Can't get the setf-method of ~S." fn)) + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method (cons (cadr fn) rest) env) ++ (get-setf-expansion (cons (cadr fn) rest) env) + (cond ((eq (car (last store-form)) (car (last vars))) + (values vars vals stores + `(apply #',(car store-form) ,@(cdr store-form)) +@@ -277,7 +268,7 @@ + + (define-setf-method char-bit (&environment env char name) + (multiple-value-bind (temps vals stores store-form access-form) +- (get-setf-method char env) ++ (get-setf-expansion char env) + (let ((ntemp (gensym)) + (store (gensym)) + (stemp (first stores))) +@@ -290,7 +281,7 @@ + + (define-setf-method ldb (&environment env bytespec int) + (multiple-value-bind (temps vals stores store-form access-form) +- (get-setf-method int env) ++ (get-setf-expansion int env) + (let ((btemp (gensym)) + (store (gensym)) + (stemp (first stores))) +@@ -303,7 +294,7 @@ + + (define-setf-method mask-field (&environment env bytespec int) + (multiple-value-bind (temps vals stores store-form access-form) +- (get-setf-method int env) ++ (get-setf-expansion int env) + (let ((btemp (gensym)) + (store (gensym)) + (stemp (first stores))) +@@ -346,7 +337,7 @@ + (setf-structure-access (cadr place) (car g) (cdr g) newvalue)))) + + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method place env) ++ (get-setf-expansion place env) + (declare (ignore access-form)) + `(let* ,(mapcar #'list + (append vars stores) +@@ -397,7 +388,7 @@ + nil)) + (when (endp (cdr r)) (error "~S is an illegal PSETF form." rest)) + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method (car r) env) ++ (get-setf-expansion (car r) env) + (declare (ignore access-form)) + (setq store-forms (cons store-form store-forms)) + (setq pairs +@@ -426,7 +417,7 @@ + ,@store-forms + ,g)) + (multiple-value-bind (vars vals stores1 store-form access-form) +- (get-setf-method (car r) env) ++ (get-setf-expansion (car r) env) + (setq pairs (nconc pairs (mapcar #'list vars vals))) + (setq stores (cons (car stores1) stores)) + (setq store-forms (cons store-form store-forms)) +@@ -451,7 +442,7 @@ + nil + )) + (multiple-value-bind (vars vals stores1 store-form access-form) +- (get-setf-method (car r) env) ++ (get-setf-expansion (car r) env) + (setq pairs (nconc pairs (mapcar #'list vars vals))) + (setq stores (cons (car stores1) stores)) + (setq store-forms (cons store-form store-forms)) +@@ -480,7 +471,7 @@ + (let ((access-form reference)) + (list 'setq reference ,update-form)))) + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method reference env) ++ (get-setf-expansion reference env) + (list 'let* + (mapcar #'list + (append vars stores) +@@ -492,7 +483,7 @@ + + (defmacro remf (&environment env place indicator) + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method place env) ++ (get-setf-expansion place env) + `(let* ,(mapcar #'list vars vals) + (multiple-value-bind (,(car stores) flag) + (si:rem-f ,access-form ,indicator) +@@ -508,7 +499,7 @@ + (return-from push `(let* ((,myitem ,item)) + (setq ,place (cons ,myitem ,place))))) + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method place env) ++ (get-setf-expansion place env) + `(let* ,(mapcar #'list + (append (list myitem) vars stores) + (append (list item) vals (list (list 'cons myitem access-form)))) +@@ -520,7 +511,7 @@ + (return-from pushnew `(let* ((,myitem ,item)) + (setq ,place (adjoin ,myitem ,place ,@rest)))))) + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method place env) ++ (get-setf-expansion place env) + `(let* ,(mapcar #'list + (append (list myitem) vars stores) + (append (list item) vals +@@ -535,7 +526,7 @@ + (setq ,place (cdr ,place)) + ,temp)))) + (multiple-value-bind (vars vals stores store-form access-form) +- (get-setf-method place env) ++ (get-setf-expansion place env) + `(let* ,(mapcar #'list + (append vars stores) + (append vals (list (list 'cdr access-form)))) +--- gcl-2.6.12.orig/lsp/gcl_sloop.lsp ++++ gcl-2.6.12/lsp/gcl_sloop.lsp +@@ -71,7 +71,7 @@ + ;;; some other package. + + +-(in-package "SLOOP" :use '(LISP)) ++(in-package "SLOOP" :use '(:LISP)) + (eval-when (compile eval load) + + (export '(loop-return sloop def-loop-collect def-loop-map +--- gcl-2.6.12.orig/lsp/gcl_stack-problem.lsp ++++ gcl-2.6.12/lsp/gcl_stack-problem.lsp +@@ -1,4 +1,4 @@ +-(in-package 'si) ++(in-package :si) + + (defvar *old-handler* #'si::universal-error-handler) + +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -24,24 +24,14 @@ + ;;;; Revised on July 11, by Carl Hoffman. + + +-(in-package "LISP") +-;(export 'lisp) +-(export '(+ ++ +++ - * ** *** / // ///)) +-(export '(break warn)) +-(export '*break-on-warnings*) +-(export '*break-enable*) +- +-(in-package 'system) ++(in-package :si) + + (export '*break-readtable*) + (export '(loc *debug-print-level*)) + + (export '(vs ihs-vs ihs-fun frs-vs frs-bds frs-ihs bds-var bds-val super-go)) + +-(eval-when +- (compile) +- (proclaim '(optimize (safety 2) (space 3))) +- (defvar *command-args* nil)) ++(defvar *command-args* nil) + + (defvar +) + (defvar ++) +@@ -75,8 +65,6 @@ + (defvar *break-enable* t) + (defvar *break-message* "") + +-(defvar *break-on-warnings* nil) +- + (defvar *break-readtable* nil) + + (defvar *top-level-hook* nil) +@@ -330,7 +318,7 @@ + (lambda-block-closure (cddddr fun)) + (t (cond + ((and (symbolp (car fun)) +- (or (special-form-p(car fun)) ++ (or (special-operator-p(car fun)) + (fboundp (car fun)))) + (car fun)) + (t '(:zombi)))))) +@@ -384,7 +372,7 @@ + (lambda-block-closure (nth 4 fun)) + (lambda-closure 'lambda-closure) + (t (if (and (symbolp (car fun)) +- (or (special-form-p (car fun)) ++ (or (special-operator-p (car fun)) + (fboundp (car fun)))) + (car fun) :zombi) + ))) +--- gcl-2.6.12.orig/lsp/gcl_trace.lsp ++++ gcl-2.6.12/lsp/gcl_trace.lsp +@@ -27,13 +27,7 @@ + ;; If you are working in another package you should (import 'si::arglist) + ;; to avoid typing the si:: + +-(in-package 'lisp) +- +-(export '(trace untrace)) +-(export 'step) +- +- +-(in-package 'system) ++(in-package :si) + + ;;(proclaim '(optimize (safety 2) (space 3))) + +@@ -169,7 +163,7 @@ + (when (null (fboundp fname)) + (format *trace-output* "The function ~S is not defined.~%" fname) + (return-from trace-one nil)) +- (when (special-form-p fname) ++ (when (special-operator-p fname) + (format *trace-output* "~S is a special form.~%" fname) + (return-from trace-one nil)) + (when (macro-function fname) +--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp ++++ gcl-2.6.12/lsp/sys-proclaim.lisp +@@ -1,294 +1,522 @@ + +-(IN-PACKAGE "SYSTEM") +-(MAPC (LAMBDA (COMPILER::X) +- (SETF (GET COMPILER::X 'PROCLAIMED-CLOSURE) T)) +- '(SI-CLASS-PRECEDENCE-LIST BREAK-ON-FLOATING-POINT-EXCEPTIONS +- SI-FIND-CLASS AUTOLOAD SI-CLASS-NAME TRACE-ONE SI-CLASSP +- SIMPLE-CONDITION-CLASS-P CONDITIONP MAKE-ACCESS-FUNCTION +- UNTRACE-ONE WARNINGP DEFINE-STRUCTURE CONDITION-CLASS-P +- SI-CLASS-OF AUTOLOAD-MACRO)) +-(PROCLAIM '(FTYPE (FUNCTION (T) (VALUES T T)) LISP::MAKE-KEYWORD)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) T) S-DATA-HAS-HOLES CONSTANTLY +- COMPUTING-ARGS-P ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS +- ANSI-LOOP::LOOP-COLLECTOR-NAME FIRST INSPECT-SYMBOL +- CONTEXT-P ANSI-LOOP::LOOP-MAKE-PSETQ TENTH +- COMPILER-MACRO-FUNCTION ANSI-LOOP::LOOP-COLLECTOR-DATA +- ARRAY-DIMENSIONS ASINH FPE::XMM-LOOKUP KNOWN-TYPE-P +- CONTEXT-VEC CONTEXT-HASH SHOW-ENVIRONMENT +- CHECK-DECLARATIONS BKPT-FILE-LINE PROVIDE +- ANSI-LOOP::LOOP-PATH-P DWIM RESTART-P FPE::LOOKUP ACOSH +- PRINT-SYMBOL-APROPOS SIGNUM ANSI-LOOP::LOOP-UNIVERSE-ANSI +- IHS-NOT-INTERPRETED-ENV BYTE-SIZE THIRD RESTART-FUNCTION +- ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS DO-F +- ANSI-LOOP::LOOP-EMIT-BODY COSH S-DATA-CONC-NAME +- INSTREAM-STREAM-NAME PATCH-SHARP INSPECT-STRING +- S-DATA-INCLUDES SHOW-BREAK-POINT FPE::GREF +- FIND-KCL-TOP-RESTART RESTART-REPORT-FUNCTION S-DATA-NAMED +- S-DATA-CONSTRUCTORS S-DATA-P SLOOP::PARSE-LOOP +- INSPECT-STRUCTURE BKPT-FORM PHASE SETUP-INFO +- ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS +- RESET-TRACE-DECLARATIONS SLOOP::SLOOP-SLOOP-MACRO EIGHTH +- SECOND SLOOP::TRANSLATE-NAME +- ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE NINTH +- ANSI-LOOP::LOOP-COLLECTOR-P MAKE-KCL-TOP-RESTART +- SEARCH-STACK ANSI-LOOP::LOOP-COLLECTOR-DTYPE ACOS +- ANSI-LOOP::LOOP-MAXMIN-COLLECTION MAKE-DEFPACKAGE-FORM +- INSPECT-NUMBER SINH ANSI-LOOP::LOOP-HACK-ITERATION +- INSTREAM-STREAM WALK-THROUGH PRINT-IHS SIXTH S-DATA-FROZEN +- INSPECT-CHARACTER SLOOP::RETURN-SLOOP-MACRO +- FREEZE-DEFSTRUCT NEXT-STACK-FRAME +- SLOOP::LOOP-COLLECT-KEYWORD-P DM-BAD-KEY +- COMPILE-FILE-PATHNAME SEVENTH +- ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD +- SLOOP::PARSE-LOOP-INITIALLY TERMINAL-INTERRUPT +- ANSI-LOOP::LOOP-EMIT-FINAL-VALUE FRS-KIND CHECK-TRACE-SPEC +- CONTEXT-SPICE ANSI-LOOP::DESTRUCTURING-SIZE +- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS INSPECT-VECTOR ATANH +- ANSI-LOOP::LOOP-PATH-NAMES S-DATA-OFFSET +- SLOOP::REPEAT-SLOOP-MACRO FIND-ALL-SYMBOLS +- ANSI-LOOP::LOOP-PATH-FUNCTION REWRITE-RESTART-CASE-CLAUSE +- ANSI-LOOP::LOOP-COLLECTOR-CLASS +- RESTART-INTERACTIVE-FUNCTION DM-KEY-NOT-ALLOWED +- INSPECT-PACKAGE S-DATA-PRINT-FUNCTION NODE-OFFSET +- RESTART-NAME RATIONAL NORMALIZE-TYPE +- SLOOP::SUBSTITUTE-SLOOP-BODY FIFTH INFO-GET-TAGS S-DATA-RAW +- RE-QUOTE-STRING SHORT-NAME LOGNOT INSPECT-ARRAY +- TRACE-ONE-PREPROCESS SIMPLE-ARRAY-P FIND-DOCUMENTATION +- BKPT-FUNCTION ANSI-LOOP::LOOP-PATH-USER-DATA EVAL-FEATURE +- ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA ABS S-DATA-STATICP +- ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE INSERT-BREAK-POINT +- S-DATA-DOCUMENTATION PRINT-FRS IHS-VISIBLE GET-INSTREAM +- INFO-GET-FILE GET-NEXT-VISIBLE-FUN DBL-EVAL FOURTH +- ANSI-LOOP::LOOP-COLLECTOR-HISTORY BYTE-POSITION +- ANSI-LOOP::LOOP-TYPED-INIT ASIN +- ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS FIX-LOAD-PATH BKPT-FILE +- VECTOR-POP IDESCRIBE UNIQUE-ID +- ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS +- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED +- SLOOP::POINTER-FOR-COLLECT FPE::ST-LOOKUP +- ANSI-LOOP::LOOP-CONSTANTP ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS +- ADD-TO-HOTLIST ANSI-LOOP::LOOP-DO-THEREIS +- ANSI-LOOP::LOOP-LIST-COLLECTION S-DATA-TYPE +- SLOOP::LOOP-LET-BINDINGS +- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED +- BREAK-FORWARD-SEARCH-STACK ISQRT S-DATA-SLOT-POSITION +- BREAK-BACKWARD-SEARCH-STACK +- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE RESTART-TEST-FUNCTION +- INVOKE-DEBUGGER SLOOP::PARSE-NO-BODY +- ANSI-LOOP::LOOP-MAKE-DESETQ +- ANSI-LOOP::LOOP-CONSTRUCT-RETURN COMPLEMENT +- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS TANH INSTREAM-P +- NODES-FROM-INDEX ANSI-LOOP::LOOP-PSEUDO-BODY +- S-DATA-INCLUDED ANSI-LOOP::LOOP-MINIMAX-TYPE +- NUMBER-OF-DAYS-FROM-1900 INFO-NODE-FROM-POSITION +- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE +- ANSI-LOOP::LOOP-MINIMAX-P BEST-ARRAY-ELEMENT-TYPE +- S-DATA-NAME SLOOP::AVERAGING-SLOOP-MACRO +- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS CIS SEQTYPE +- LEAP-YEAR-P GET-BYTE-STREAM-NCHARS IHS-FNAME +- ANSI-LOOP::LOOP-UNIVERSE-P INSPECT-CONS +- S-DATA-SLOT-DESCRIPTIONS)) +-(PROCLAIM +- '(FTYPE (FUNCTION (*) *) INFO-ERROR BREAK-PREVIOUS BREAK-NEXT +- CONTINUE BREAK-LOCAL SHOW-BREAK-VARIABLES BREAK-BDS +- MUFFLE-WARNING DBL-BACKTRACE ANSI-LOOP::LOOP-OPTIONAL-TYPE +- IHS-BACKTRACE BREAK-QUIT BREAK-VS)) +-(PROCLAIM +- '(FTYPE (FUNCTION (FIXNUM) FIXNUM) FPE::FE-ENABLE DBL-WHAT-FRAME)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) FIXNUM) INSTREAM-LINE FPE::REG-LOOKUP +- S-DATA-SIZE S-DATA-LENGTH THE-START)) +-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) PUSH-CONTEXT GET-CONTEXT)) +-(PROCLAIM '(FTYPE (FUNCTION (STRING FIXNUM) FIXNUM) ATOI)) +-(PROCLAIM +- '(FTYPE (FUNCTION (*) T) ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE +- MAYBE-CLEAR-INPUT ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL +- DRIBBLE ANSI-LOOP::MAKE-LOOP-COLLECTOR +- ANSI-LOOP::MAKE-LOOP-UNIVERSE Y-OR-N-P COMPUTE-RESTARTS +- DESCRIBE-ENVIRONMENT TRANSFORM-KEYWORDS +- SLOOP::PARSE-LOOP-DECLARE MAKE-RESTART MAKE-INSTREAM +- ANSI-LOOP::LOOP-GENTEMP DBL-READ LOC CURRENT-STEP-FUN +- VECTOR YES-OR-NO-P BREAK +- ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL STEP-INTO MAKE-CONTEXT +- ANSI-LOOP::MAKE-LOOP-PATH MAKE-S-DATA BREAK-LOCALS ABORT +- SLOOP::PARSE-LOOP-WITH STEP-NEXT)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) *) PRINC-TO-STRING GET-&ENVIRONMENT DESCRIBE +- INSPECT ANSI-LOOP::NAMED-VARIABLE WAITING +- ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES PRIN1-TO-STRING +- BREAK-LEVEL-INVOKE-RESTART END-WAITING +- ANSI-LOOP::LOOP-LIST-STEP ALOAD INSTREAM-NAME +- INVOKE-RESTART-INTERACTIVELY FIND-DECLARATIONS BREAK-GO +- INSPECT-OBJECT INFO-SUBFILE)) +-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM T T) T) BIGNTHCDR)) +-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM FIXNUM T T) T) QUICK-SORT)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T) *) SHARP-S-READER SHARP---READER +- ANSI-LOOP::LOOP-GET-COLLECTION-INFO SHARP-+-READER +- LIST-MERGE-SORT LISP::VERIFY-KEYWORDS READ-INSPECT-COMMAND +- RESTART-PRINT)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T *) *) REDUCE SUBTYPEP SORT +- SLOOP::FIND-IN-ORDERED-LIST STABLE-SORT LISP::PARSE-BODY)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T *) *) LISP::PARSE-DEFMACRO-LAMBDA-LIST +- LISP::PARSE-DEFMACRO)) +-(PROCLAIM '(FTYPE (FUNCTION (T T T *) *) MASET)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T T T) *) LISP::PUSH-OPTIONAL-BINDING)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T *) *) DECODE-UNIVERSAL-TIME STEPPER USE-VALUE +- FROUND INFO SHOW-INFO INVOKE-RESTART FCEILING +- PARSE-BODY-HEADER ENSURE-DIRECTORIES-EXIST PRINT-DOC +- APROPOS-DOC WRITE-TO-STRING FFLOOR NLOAD BREAK-FUNCTION +- REQUIRE APROPOS GET-SETF-METHOD APROPOS-LIST +- ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE STORE-VALUE +- GET-SETF-METHOD-MULTIPLE-VALUE READ-FROM-STRING +- WILD-PATHNAME-P FTRUNCATE)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T) T) QUOTATION-READER +- SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::NEVER-SLOOP-COLLECT +- MATCH-DIMENSIONS OBJLT ANSI-LOOP::LOOP-TEQUAL DBL-UP +- GET-INFO-CHOICES NTHCDR ANSI-LOOP::LOOP-DECLARE-VARIABLE +- ANSI-LOOP::MAKE-LOOP-MINIMAX LDB +- OVERWRITE-SLOT-DESCRIPTIONS GET-LINE-OF-FORM DOCUMENTATION +- DM-NTH ANSI-LOOP::LOOP-LOOKUP-KEYWORD DM-NTH-CDR +- SLOOP::=-SLOOP-FOR LIST-DELQ SET-DIR LOGANDC2 +- SLOOP::IN-FRINGE-SLOOP-MAP DISPLAY-COMPILED-ENV SET-BACK +- SLOOP::LOGXOR-SLOOP-COLLECT LEFT-PARENTHESIS-READER +- ANSI-LOOP::LOOP-DO-IF FPE::%-READER LDB-TEST +- COMPILER::COMPILER-DEF-HOOK BYTE +- SLOOP::IN-CAREFULLY-SLOOP-FOR INCREMENT-CURSOR +- IN-INTERVAL-P LISP::LOOKUP-KEYWORD SUPER-GO WRITE-BYTE +- ANSI-LOOP::LOOP-DO-WHILE READ-INSTRUCTION LOGANDC1 +- SLOOP::THEREIS-SLOOP-COLLECT COERCE-TO-STRING LOGORC2 +- SEQUENCE-CURSOR LOGNOR FPE::READ-OPERANDS +- SLOOP::MAXIMIZE-SLOOP-COLLECT ALL-MATCHES +- SLOOP::IN-TABLE-SLOOP-MAP SLOOP::COLLATE-SLOOP-COLLECT +- CHECK-SEQ-START-END BREAK-STEP-NEXT FPE::RF +- SLOOP::PARSE-LOOP-MAP VECTOR-PUSH FPE::PAREN-READER +- FPE::0-READER ANSI-LOOP::LOOP-TASSOC SETF-HELPER +- SETF-EXPAND SLOOP::MINIMIZE-SLOOP-COLLECT ADD-FILE LOGORC1 +- SLOOP::COUNT-SLOOP-COLLECT SLOOP::MAKE-VALUE +- PARSE-SLOT-DESCRIPTION SLOOP::DESETQ1 +- ANSI-LOOP::LOOP-DO-ALWAYS SLOOP::L-EQUAL GET-MATCH +- SLOOP::SUM-SLOOP-COLLECT DM-V BREAK-STEP-INTO LOGNAND NTH +- SUBSTRINGP INFO-AUX SUB-INTERVAL-P *BREAK-POINTS* SAFE-EVAL +- ANSI-LOOP::HIDE-VARIABLE-REFERENCES COERCE +- ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION CONDITION-PASS +- GET-NODES ANSI-LOOP::LOOP-TMEMBER +- SLOOP::ALWAYS-SLOOP-COLLECT DISPLAY-ENV SLOOP::THE-TYPE +- ANSI-LOOP::LOOP-MAYBE-BIND-FORM ITERATE-OVER-BKPTS LOGTEST +- LISP::KEYWORD-SUPPLIED-P)) +-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T T) *) TRACE-CALL)) +-(PROCLAIM +- '(FTYPE (FUNCTION NIL *) GCL-TOP-LEVEL SIMPLE-BACKTRACE +- BREAK-CURRENT BREAK-MESSAGE ANSI-LOOP::LOOP-DO-FOR +- BREAK-HELP)) +-(PROCLAIM +- '(FTYPE (FUNCTION (STRING) T) RESET-SYS-PATHS +- COERCE-SLASH-TERMINATED)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T) FIXNUM) RELATIVE-LINE GET-NODE-INDEX +- ANSI-LOOP::DUPLICATABLE-CODE-P THE-END)) +-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T) T) SMALLNTHCDR)) +-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM FIXNUM) FIXNUM) ROUND-UP)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T *) T) +- ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES SBIT +- INFO-SEARCH PROCESS-ARGS LIST-MATCHES ARRAY-ROW-MAJOR-INDEX +- FIND-RESTART SLOOP::LOOP-ADD-TEMPS ANSI-LOOP::LOOP-WARN +- ANSI-LOOP::LOOP-ERROR BAD-SEQ-LIMIT ARRAY-IN-BOUNDS-P +- MAKE-ARRAY SIGNAL BIT PROCESS-SOME-ARGS CONCATENATE ERROR +- REMOVE-DUPLICATES SLOOP::ADD-FROM-DATA READ-BYTE +- FILE-SEARCH FILE-TO-STRING UPGRADED-ARRAY-ELEMENT-TYPE WARN +- BREAK-LEVEL BIT-NOT NTH-STACK-FRAME DELETE-DUPLICATES)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T) *) ANSI-LOOP::ESTIMATE-CODE-SIZE-1 NEWLINE +- FIND-DOC RESTART-REPORT ANSI-LOOP::ESTIMATE-CODE-SIZE +- NEW-SEMI-COLON-READER)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T *) T) NOTANY BIT-ORC1 +- ANSI-LOOP::LOOP-CHECK-DATA-TYPE REMOVE BIT-ANDC1 +- INTERNAL-COUNT-IF-NOT READ-SEQUENCE SUBSETP +- VECTOR-PUSH-EXTEND TYPEP CERROR REPLACE COUNT-IF +- NSET-DIFFERENCE DELETE REMOVE-IF NSET-EXCLUSIVE-OR +- PROCESS-ERROR INTERNAL-COUNT SLOOP::IN-ARRAY-SLOOP-FOR +- SEARCH MAKE-SEQUENCE ADJUST-ARRAY BIT-NAND FIND-IF +- NINTERSECTION FILL BIT-ORC2 BIT-XOR UNION DELETE-IF-NOT +- SLOOP::PARSE-LOOP-MACRO WRITE-SEQUENCE SOME COUNT-IF-NOT +- MAP-INTO FIND FIND-IF-NOT BIT-NOR BIT-ANDC2 POSITION-IF +- NOTEVERY NUNION SET-DIFFERENCE INTERSECTION POSITION-IF-NOT +- EVERY POSITION FIND-IHS BIT-EQV REMOVE-IF-NOT MISMATCH +- BIT-AND INTERNAL-COUNT-IF DELETE-IF COUNT BREAK-CALL +- SET-EXCLUSIVE-OR SLOOP::LOOP-ADD-BINDING BIT-IOR)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T) T) ANSI-LOOP::LOOP-FOR-IN +- FLOATING-POINT-ERROR CHECK-TRACE-ARGS +- ANSI-LOOP::HIDE-VARIABLE-REFERENCE SETF-EXPAND-1 +- MAKE-BREAK-POINT FPE::REF SHARP-A-READER SHARP-U-READER DPB +- DM-VL CHECK-S-DATA ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE +- APPLY-DISPLAY-FUN ANSI-LOOP::LOOP-STANDARD-EXPANSION +- ANSI-LOOP::LOOP-TRANSLATE DEPOSIT-FIELD +- ANSI-LOOP::LOOP-ANSI-FOR-EQUALS +- SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS +- ANSI-LOOP::LOOP-FOR-ON GET-SLOT-POS +- ANSI-LOOP::PRINT-LOOP-UNIVERSE DEFMACRO* WARN-VERSION +- RESTART-CASE-EXPRESSION-CONDITION MAKE-T-TYPE +- ANSI-LOOP::LOOP-SUM-COLLECTION ANSI-LOOP::LOOP-FOR-BEING +- ANSI-LOOP::LOOP-FOR-ACROSS)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T *) T) CHECK-TYPE-SYMBOL +- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH NSUBSTITUTE-IF +- SUBSTITUTE-IF +- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH NSUBSTITUTE +- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH +- LISP::PUSH-LET-BINDING ANSI-LOOP::ADD-LOOP-PATH +- SUBSTITUTE-IF-NOT MAP SLOOP::LOOP-DECLARE-BINDING +- SUBSTITUTE ANSI-LOOP::LOOP-MAKE-VARIABLE NSUBSTITUTE-IF-NOT +- COMPLETE-PROP)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T) T) LISP::DO-ARG-COUNT-ERROR +- LISP::PUSH-SUB-LIST-BINDING)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T) T) MAKE-CONSTRUCTOR MAKE-PREDICATE +- DO-BREAK-LEVEL)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T *) T) PRINT-STACK-FRAME MERGE +- SLOOP::DEF-LOOP-INTERNAL)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T FIXNUM) T) SHARP-EQ-READER +- SHARP-SHARP-READER)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T) T) CALL-TEST COERCE-TO-CONDITION +- FIND-LINE-IN-FUN ANSI-LOOP::LOOP-FOR-ARITHMETIC MAYBE-BREAK +- SLOOP::FIRST-USE-SLOOP-FOR SLOOP::FIRST-SLOOP-FOR +- SETF-STRUCTURE-ACCESS)) +-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T *) T) ENCODE-UNIVERSAL-TIME)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T T T T T) T) +- ANSI-LOOP::LOOP-SEQUENCER)) +-(PROCLAIM '(FTYPE (FUNCTION (T T T T T *) T) UNIVERSAL-ERROR-HANDLER)) +-(PROCLAIM +- '(FTYPE (FUNCTION NIL T) ANSI-LOOP::LOOP-DO-NAMED +- SLOOP::LOOP-UN-POP ANSI-LOOP::LOOP-DO-INITIALLY +- SLOOP::PARSE-LOOP-WHEN SLOOP::LOOP-POP SLOOP::LOOP-PEEK +- SLOOP::PARSE-LOOP-DO SET-ENV ANSI-LOOP::LOOP-DO-REPEAT +- READ-EVALUATED-FORM ANSI-LOOP::LOOP-DO-RETURN +- ANSI-LOOP::LOOP-GET-FORM ANSI-LOOP::LOOP-DO-FINALLY +- SET-CURRENT DEFAULT-SYSTEM-BANNER DM-TOO-FEW-ARGUMENTS +- ANSI-LOOP::LOOP-DO-DO SLOOP::PARSE-ONE-WHEN-CLAUSE +- DEFAULT-INFO-HOTLIST KCL-TOP-RESTARTS TYPE-ERROR +- SET-UP-TOP-LEVEL INSPECT-INDENT GET-INDEX-NODE +- ALL-TRACE-DECLARATIONS DBL ANSI-LOOP::LOOP-GET-PROGN +- INIT-BREAK-POINTS STEP-READ-LINE +- ANSI-LOOP::LOOP-ITERATION-DRIVER GET-SIG-FN-NAME +- SETUP-LINEINFO CLEANUP ANSI-LOOP::LOOP-WHEN-IT-VARIABLE +- ANSI-LOOP::LOOP-DO-WITH SHOW-RESTARTS +- SLOOP::PARSE-LOOP-COLLECT INSPECT-READ-LINE +- DM-TOO-MANY-ARGUMENTS INSPECT-INDENT-1 +- ANSI-LOOP::LOOP-POP-SOURCE TEST-ERROR SLOOP::PARSE-LOOP1 +- ANSI-LOOP::LOOP-CONTEXT ANSI-LOOP::LOOP-BIND-BLOCK +- WINE-TMP-REDIRECT ILLEGAL-BOA SLOOP::PARSE-LOOP-FOR +- TOP-LEVEL LISP-IMPLEMENTATION-VERSION GET-TEMP-DIR)) +\ No newline at end of file ++(COMMON-LISP::IN-PACKAGE "SYSTEM") ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ ANSI-LOOP::LOOP-EMIT-FINAL-VALUE SYSTEM::INSPECT-CHARACTER ++ SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS ++ SYSTEM::RESTART-FUNCTION COMMON-LISP::TANH COMMON-LISP::FIFTH ++ SLOOP::PARSE-LOOP-INITIALLY SYSTEM::NEXT-STACK-FRAME ++ SYSTEM::IDESCRIBE SYSTEM::PROCESS-ARGS SYSTEM::LEAP-YEAR-P ++ SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::FIX-LOAD-PATH ++ SLOOP::SUBSTITUTE-SLOOP-BODY SYSTEM::RESTART-REPORT-FUNCTION ++ COMMON-LISP::NINTH SLOOP::SLOOP-SLOOP-MACRO ++ SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::FREEZE-DEFSTRUCT ++ COMMON-LISP::EIGHTH SYSTEM::FIND-DOCUMENTATION ++ ANSI-LOOP::LOOP-PSEUDO-BODY COMMON-LISP::RATIONAL ++ ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ASIN ++ COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::S-DATA-P ++ SYSTEM::BKPT-FUNCTION SYSTEM::TRACE-ONE-PREPROCESS ++ COMMON-LISP::LOGNOT SYSTEM::SIMPLE-ARRAY-P SYSTEM::BKPT-FILE ++ SYSTEM::S-DATA-STATICP COMMON-LISP::ISQRT SYSTEM::INSTREAM-P ++ COMMON-LISP::SEVENTH SYSTEM::S-DATA-NAMED ++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-NUMBER ++ COMMON-LISP::ATANH SYSTEM::RESTART-TEST-FUNCTION ++ SYSTEM::S-DATA-INCLUDES SYSTEM::S-DATA-HAS-HOLES ++ SYSTEM::CONTEXT-VEC FPE::XMM-LOOKUP SYSTEM::S-DATA-RAW ++ ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS ++ SYSTEM::RESTART-INTERACTIVE-FUNCTION ++ ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS ++ ANSI-LOOP::LOOP-COLLECTOR-NAME ANSI-LOOP::LOOP-PATH-NAMES ++ ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE ++ SYSTEM::S-DATA-INCLUDED SYSTEM::S-DATA-SLOT-DESCRIPTIONS ++ SYSTEM::S-DATA-OFFSET SLOOP::REPEAT-SLOOP-MACRO ++ SYSTEM::S-DATA-PRINT-FUNCTION ANSI-LOOP::LOOP-PATH-USER-DATA ++ COMMON-LISP::FIND-ALL-SYMBOLS COMMON-LISP::FIRST ++ SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::BKPT-FORM ++ SYSTEM::NODES-FROM-INDEX SYSTEM::INSPECT-SYMBOL ++ SYSTEM::KNOWN-TYPE-P ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE ++ SYSTEM::MAKE-DEFPACKAGE-FORM COMMON-LISP::ARRAY-DIMENSIONS ++ SYSTEM::INSERT-BREAK-POINT SLOOP::PARSE-LOOP ++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS SYSTEM::SHORT-NAME ++ SYSTEM::CHECK-TRACE-SPEC ANSI-LOOP::DESTRUCTURING-SIZE ++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::CONTEXT-HASH ++ COMMON-LISP::SIXTH SYSTEM::IHS-VISIBLE SYSTEM::INSPECT-ARRAY ++ COMMON-LISP::BYTE-SIZE ANSI-LOOP::LOOP-COLLECTOR-CLASS ++ ANSI-LOOP::LOOP-HACK-ITERATION ++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::S-DATA-SLOT-POSITION ++ ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE SYSTEM::INSPECT-STRING ++ COMMON-LISP::PROVIDE COMMON-LISP::CIS ++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS ++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK ++ ANSI-LOOP::LOOP-COLLECTOR-DTYPE ++ SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK ++ COMMON-LISP::TENTH ANSI-LOOP::LOOP-DO-THEREIS ++ ANSI-LOOP::LOOP-MAXMIN-COLLECTION ++ ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA ++ ANSI-LOOP::LOOP-MAKE-PSETQ SYSTEM::ADD-TO-HOTLIST ++ SYSTEM::INSPECT-CONS ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS ++ SYSTEM::INSPECT-VECTOR COMMON-LISP::CONSTANTLY ++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE SYSTEM::DM-BAD-KEY ++ SYSTEM::PRINT-SYMBOL-APROPOS SYSTEM::FRS-KIND FPE::ST-LOOKUP ++ COMMON-LISP::FOURTH SYSTEM::TERMINAL-INTERRUPT ++ SYSTEM::DM-KEY-NOT-ALLOWED SYSTEM::UNIQUE-ID ++ SYSTEM::S-DATA-FROZEN SLOOP::POINTER-FOR-COLLECT ++ SYSTEM::INSPECT-PACKAGE SYSTEM::DBL-EVAL ++ ANSI-LOOP::LOOP-MINIMAX-TYPE ANSI-LOOP::LOOP-UNIVERSE-ANSI ++ ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS SYSTEM::DWIM ++ SYSTEM::INSTREAM-STREAM-NAME SLOOP::RETURN-SLOOP-MACRO ++ SYSTEM::PATCH-SHARP SYSTEM::CONTEXT-P SYSTEM::INFO-GET-FILE ++ SYSTEM::RESTART-P COMMON-LISP::COSH COMMON-LISP::SINH ++ SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::CHECK-DECLARATIONS ++ SYSTEM::GET-INSTREAM ++ ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD SYSTEM::S-DATA-NAME ++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS ++ SYSTEM::S-DATA-DOCUMENTATION SYSTEM::SHOW-BREAK-POINT ++ COMMON-LISP::ACOS COMMON-LISP::INVOKE-DEBUGGER ++ SYSTEM::BKPT-FILE-LINE ANSI-LOOP::LOOP-COLLECTOR-DATA ++ COMMON-LISP::THIRD SYSTEM::S-DATA-CONC-NAME ++ COMMON-LISP::SIGNUM ++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++ SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-TYPED-INIT ++ ANSI-LOOP::LOOP-PATH-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION ++ COMMON-LISP::ASINH SYSTEM::RE-QUOTE-STRING ++ SLOOP::LOOP-COLLECT-KEYWORD-P SYSTEM::PRINT-FRS ++ SYSTEM::EVAL-FEATURE ANSI-LOOP::LOOP-COLLECTOR-P ++ ANSI-LOOP::LOOP-COLLECTOR-HISTORY ++ ANSI-LOOP::LOOP-LIST-COLLECTION ++ SYSTEM::BREAK-FORWARD-SEARCH-STACK COMMON-LISP::RESTART-NAME ++ SLOOP::PARSE-NO-BODY ANSI-LOOP::LOOP-UNIVERSE-P ++ SYSTEM::NUMBER-OF-DAYS-FROM-1900 SYSTEM::NODE-OFFSET ++ ANSI-LOOP::LOOP-MINIMAX-P SYSTEM::IHS-FNAME FPE::LOOKUP ++ SLOOP::LOOP-LET-BINDINGS FPE::GREF COMMON-LISP::PHASE ++ COMMON-LISP::BYTE-POSITION SYSTEM::INSTREAM-STREAM ++ ANSI-LOOP::LOOP-PATH-P SYSTEM::SEQTYPE COMMON-LISP::ACOSH ++ COMMON-LISP::ABS COMMON-LISP::COMPLEMENT ++ ANSI-LOOP::LOOP-CONSTANTP SYSTEM::WALK-THROUGH ++ SYSTEM::SETUP-INFO SYSTEM::COMPUTING-ARGS-P ++ SYSTEM::CONTEXT-SPICE SYSTEM::MAKE-KCL-TOP-RESTART ++ COMMON-LISP::COMPILER-MACRO-FUNCTION ++ ANSI-LOOP::LOOP-MAKE-DESETQ SYSTEM::SHOW-ENVIRONMENT ++ SLOOP::TRANSLATE-NAME SYSTEM::INFO-GET-TAGS ++ COMMON-LISP::SECOND SYSTEM::RESET-TRACE-DECLARATIONS ++ SYSTEM::S-DATA-TYPE SYSTEM::FIND-KCL-TOP-RESTART ++ ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::DO-F ++ ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS COMMON-LISP::VECTOR-POP)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ SYSTEM::IHS-BACKTRACE SYSTEM::BREAK-NEXT SYSTEM::BREAK-QUIT ++ SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-BDS ++ COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS ++ SYSTEM::INFO-ERROR ANSI-LOOP::LOOP-OPTIONAL-TYPE ++ SYSTEM::DBL-BACKTRACE SYSTEM::BREAK-LOCAL SYSTEM::BREAK-VS ++ COMMON-LISP::CONTINUE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::DBL-WHAT-FRAME FPE::FE-ENABLE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMMON-LISP::SUBTYPEP COMMON-LISP::REDUCE SYSTEM::PARSE-BODY ++ COMMON-LISP::STABLE-SORT COMMON-LISP::SORT ++ SLOOP::FIND-IN-ORDERED-LIST)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT ++ ANSI-LOOP::LOOP-GET-COLLECTION-INFO SYSTEM::LIST-MERGE-SORT ++ SYSTEM::READ-INSPECT-COMMAND SYSTEM::SHARP---READER ++ SYSTEM::SHARP-+-READER SYSTEM::SHARP-S-READER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::PUSH-OPTIONAL-BINDING)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::TRACE-CALL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::MASET)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE SYSTEM::THE-START ++ SYSTEM::S-DATA-LENGTH SYSTEM::S-DATA-SIZE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++ SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL ++ SYSTEM::BREAK-MESSAGE SYSTEM::BREAK-RESUME ++ ANSI-LOOP::LOOP-DO-FOR SYSTEM::SIMPLE-BACKTRACE ++ SYSTEM::BREAK-HELP)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T) ++ SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::RESET-SYS-PATHS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMMON-LISP::BIT COMMON-LISP::READ-BYTE ++ COMMON-LISP::CONCATENATE SYSTEM::INFO-SEARCH ++ COMMON-LISP::ARRAY-IN-BOUNDS-P ANSI-LOOP::LOOP-ERROR ++ ANSI-LOOP::LOOP-WARN COMMON-LISP::REMOVE-DUPLICATES ++ SYSTEM::BAD-SEQ-LIMIT SYSTEM::PROCESS-SOME-ARGS ++ ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES ++ SLOOP::LOOP-ADD-TEMPS COMMON-LISP::BIT-NOT COMMON-LISP::SIGNAL ++ SYSTEM::NTH-STACK-FRAME COMMON-LISP::ARRAY-ROW-MAJOR-INDEX ++ COMMON-LISP::MAKE-ARRAY SYSTEM::FILE-SEARCH ++ SYSTEM::LIST-MATCHES COMMON-LISP::FIND-RESTART ++ SYSTEM::BREAK-LEVEL COMMON-LISP::DELETE-DUPLICATES ++ SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR COMMON-LISP::WARN ++ SYSTEM::FILE-TO-STRING ++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::SBIT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::FIND-DOC SYSTEM::RESTART-REPORT ++ ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::NEWLINE ++ ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEW-SEMI-COLON-READER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++ SYSTEM::MAKE-KEYWORD)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP ++ SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::UNTRACE-ONE ++ SYSTEM::CONDITIONP SYSTEM::CONDITION-CLASS-P ++ SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SI-CLASS-NAME ++ SYSTEM::AUTOLOAD-MACRO SYSTEM::AUTOLOAD SYSTEM::SI-CLASS-OF ++ SYSTEM::WARNINGP SYSTEM::DEFINE-STRUCTURE ++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::SI-FIND-CLASS ++ SYSTEM::TRACE-ONE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::QUICK-SORT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::BIGNTHCDR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ANSI-LOOP::LOOP-FOR-IN ++ SYSTEM::DEFMACRO* SYSTEM::APPLY-DISPLAY-FUN ++ SYSTEM::WARN-VERSION ANSI-LOOP::HIDE-VARIABLE-REFERENCE ++ SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-FOR-ACROSS ++ SYSTEM::DM-VL SYSTEM::GET-SLOT-POS ++ SYSTEM::RESTART-CASE-EXPRESSION-CONDITION ++ SYSTEM::CHECK-TRACE-ARGS ANSI-LOOP::LOOP-FOR-ON FPE::REF ++ ANSI-LOOP::PRINT-LOOP-UNIVERSE ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ++ SYSTEM::SETF-EXPAND-1 ANSI-LOOP::LOOP-SUM-COLLECTION ++ ANSI-LOOP::LOOP-STANDARD-EXPANSION SYSTEM::MAKE-T-TYPE ++ COMMON-LISP::DEPOSIT-FIELD SYSTEM::MAKE-BREAK-POINT ++ ANSI-LOOP::LOOP-FOR-BEING ANSI-LOOP::LOOP-TRANSLATE ++ SYSTEM::SHARP-A-READER COMMON-LISP::DPB ++ SYSTEM::FLOATING-POINT-ERROR SYSTEM::CHECK-S-DATA ++ SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION ++ SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC ++ SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS ++ SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMMON-LISP::COUNT-IF COMMON-LISP::BIT-ANDC2 ++ COMMON-LISP::REMOVE SYSTEM::INTERNAL-COUNT-IF ++ SLOOP::LOOP-ADD-BINDING COMMON-LISP::MAP-INTO ++ COMMON-LISP::FIND-IF COMMON-LISP::NSET-DIFFERENCE ++ COMMON-LISP::UNION COMMON-LISP::NUNION ++ COMMON-LISP::MAKE-SEQUENCE COMMON-LISP::NOTANY ++ COMMON-LISP::POSITION COMMON-LISP::DELETE-IF ++ COMMON-LISP::BIT-ORC2 COMMON-LISP::REPLACE COMMON-LISP::DELETE ++ SYSTEM::BREAK-CALL COMMON-LISP::NINTERSECTION ++ COMMON-LISP::POSITION-IF SYSTEM::FIND-IHS COMMON-LISP::BIT-AND ++ COMMON-LISP::DELETE-IF-NOT ANSI-LOOP::LOOP-CHECK-DATA-TYPE ++ COMMON-LISP::REMOVE-IF COMMON-LISP::READ-SEQUENCE ++ SLOOP::PARSE-LOOP-MACRO COMMON-LISP::BIT-NAND ++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::SUBSETP ++ COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::EVERY ++ COMMON-LISP::SOME COMMON-LISP::WRITE-SEQUENCE ++ COMMON-LISP::MISMATCH COMMON-LISP::SET-EXCLUSIVE-OR ++ COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::BIT-NOR ++ COMMON-LISP::BIT-XOR COMMON-LISP::BIT-EQV COMMON-LISP::SEARCH ++ COMMON-LISP::SET-DIFFERENCE COMMON-LISP::FILL ++ COMMON-LISP::CERROR COMMON-LISP::ADJUST-ARRAY ++ COMMON-LISP::BIT-ORC1 SYSTEM::INTERNAL-COUNT ++ COMMON-LISP::TYPEP SYSTEM::PROCESS-ERROR ++ COMMON-LISP::COUNT-IF-NOT COMMON-LISP::INTERSECTION ++ SLOOP::IN-ARRAY-SLOOP-FOR COMMON-LISP::FIND-IF-NOT ++ COMMON-LISP::BIT-ANDC1 COMMON-LISP::POSITION-IF-NOT ++ COMMON-LISP::NOTEVERY COMMON-LISP::NSET-EXCLUSIVE-OR ++ COMMON-LISP::FIND COMMON-LISP::COUNT COMMON-LISP::BIT-IOR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::MAP ++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH ++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH ++ COMMON-LISP::SUBSTITUTE COMMON-LISP::NSUBSTITUTE ++ COMMON-LISP::NSUBSTITUTE-IF-NOT ANSI-LOOP::LOOP-MAKE-VARIABLE ++ COMMON-LISP::SUBSTITUTE-IF-NOT ++ ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH ++ SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE-IF ++ SYSTEM::CHECK-TYPE-SYMBOL SLOOP::LOOP-DECLARE-BINDING ++ SYSTEM::COMPLETE-PROP COMMON-LISP::NSUBSTITUTE-IF)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::MAKE-PREDICATE SYSTEM::DO-BREAK-LEVEL ++ SYSTEM::MAKE-CONSTRUCTOR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ SYSTEM::UNIVERSAL-ERROR-HANDLER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM) ++ COMMON-LISP::T) ++ SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ SLOOP::DEF-LOOP-INTERNAL SYSTEM::PRINT-STACK-FRAME ++ COMMON-LISP::MERGE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMMON-LISP::ENCODE-UNIVERSAL-TIME)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ ANSI-LOOP::LOOP-SEQUENCER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::STRING COMMON-LISP::FIXNUM) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::ATOI)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::STEP-NEXT ++ COMMON-LISP::BREAK COMMON-LISP::ABORT SYSTEM::MAKE-S-DATA ++ ANSI-LOOP::MAKE-LOOP-COLLECTOR SLOOP::PARSE-LOOP-DECLARE ++ ANSI-LOOP::LOOP-GENTEMP SYSTEM::MAKE-INSTREAM ++ SYSTEM::MAYBE-CLEAR-INPUT ++ ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL COMMON-LISP::Y-OR-N-P ++ SYSTEM::CURRENT-STEP-FUN ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL ++ COMMON-LISP::DRIBBLE SYSTEM::MAKE-RESTART ++ SLOOP::PARSE-LOOP-WITH SYSTEM::LOC COMMON-LISP::YES-OR-NO-P ++ SYSTEM::TRANSFORM-KEYWORDS SYSTEM::MAKE-CONTEXT ++ COMMON-LISP::COMPUTE-RESTARTS SYSTEM::DBL-READ ++ SYSTEM::STEP-INTO ANSI-LOOP::MAKE-LOOP-UNIVERSE ++ SYSTEM::BREAK-LOCALS ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++ COMMON-LISP::VECTOR ANSI-LOOP::MAKE-LOOP-PATH)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ ANSI-LOOP::LOOP-LIST-STEP SYSTEM::INSPECT-OBJECT ++ COMMON-LISP::DESCRIBE ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES ++ SYSTEM::BREAK-GO SYSTEM::GET-&ENVIRONMENT ++ COMMON-LISP::PRINC-TO-STRING SYSTEM::WAITING ++ SYSTEM::INSTREAM-NAME ANSI-LOOP::NAMED-VARIABLE ++ COMMON-LISP::PRIN1-TO-STRING SYSTEM::INFO-SUBFILE ++ COMMON-LISP::INSPECT SYSTEM::END-WAITING ++ SYSTEM::FIND-DECLARATIONS ++ COMMON-LISP::INVOKE-RESTART-INTERACTIVELY ++ SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::ALOAD)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ ANSI-LOOP::MAKE-LOOP-MINIMAX COMMON-LISP::LDB ++ SYSTEM::LIST-DELQ FPE::RF SLOOP::L-EQUAL ++ ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::DISPLAY-COMPILED-ENV ++ SYSTEM::SET-BACK ANSI-LOOP::HIDE-VARIABLE-REFERENCES ++ SYSTEM::GET-LINE-OF-FORM SYSTEM::BREAK-STEP-INTO ++ SLOOP::THE-TYPE SLOOP::COUNT-SLOOP-COLLECT ++ SYSTEM::KEYWORD-SUPPLIED-P COMMON-LISP::LOGANDC2 ++ ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::SET-DIR ++ SYSTEM::COERCE-TO-STRING COMMON-LISP::VECTOR-PUSH ++ SYSTEM::DM-NTH-CDR SLOOP::IN-FRINGE-SLOOP-MAP ++ SLOOP::MAXIMIZE-SLOOP-COLLECT SYSTEM::ADD-FILE ++ SYSTEM::ALL-MATCHES SYSTEM::DM-NTH ++ SLOOP::IN-CAREFULLY-SLOOP-FOR SYSTEM::PARSE-SLOT-DESCRIPTION ++ ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::0-READER ++ ANSI-LOOP::LOOP-TMEMBER COMPILER::COMPILER-DEF-HOOK ++ SYSTEM::INFO-AUX COMMON-LISP::NTH SYSTEM::QUOTATION-READER ++ SYSTEM::CHECK-SEQ-START-END COMMON-LISP::LOGNAND ++ SYSTEM::SUBSTRINGP COMMON-LISP::LOGORC2 ++ ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION SYSTEM::SAFE-EVAL ++ ANSI-LOOP::LOOP-DO-IF SLOOP::THEREIS-SLOOP-COLLECT ++ SYSTEM::MATCH-DIMENSIONS SYSTEM::GET-MATCH ++ SYSTEM::SUB-INTERVAL-P FPE::PAREN-READER ++ SLOOP::IN-TABLE-SLOOP-MAP COMMON-LISP::LOGTEST ++ SLOOP::LOGXOR-SLOOP-COLLECT SYSTEM::DM-V ++ SYSTEM::GET-INFO-CHOICES SLOOP::COLLATE-SLOOP-COLLECT ++ SYSTEM::BREAK-STEP-NEXT ANSI-LOOP::LOOP-TEQUAL ++ COMMON-LISP::WRITE-BYTE COMMON-LISP::NTHCDR ++ SYSTEM::SETF-HELPER SLOOP::NEVER-SLOOP-COLLECT SLOOP::DESETQ1 ++ ANSI-LOOP::LOOP-DO-WHILE COMMON-LISP::DOCUMENTATION ++ FPE::%-READER SYSTEM::IN-INTERVAL-P SLOOP::SUM-SLOOP-COLLECT ++ SYSTEM::OBJLT COMMON-LISP::LDB-TEST SLOOP::PARSE-LOOP-MAP ++ SYSTEM::GET-NODES SLOOP::MAKE-VALUE SYSTEM::CONDITION-PASS ++ SLOOP::IN-PACKAGE-SLOOP-MAP SYSTEM::INCREMENT-CURSOR ++ ANSI-LOOP::LOOP-DO-ALWAYS SYSTEM::DISPLAY-ENV SYSTEM::SUPER-GO ++ SLOOP::MINIMIZE-SLOOP-COLLECT COMMON-LISP::LOGNOR ++ COMMON-LISP::LOGANDC1 COMMON-LISP::BYTE SYSTEM::DBL-UP ++ SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGORC1 ++ FPE::READ-OPERANDS SLOOP::ALWAYS-SLOOP-COLLECT ++ SYSTEM::SETF-EXPAND SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS ++ SYSTEM::*BREAK-POINTS* SYSTEM::LOOKUP-KEYWORD ++ ANSI-LOOP::LOOP-TASSOC SYSTEM::LEFT-PARENTHESIS-READER ++ SLOOP::=-SLOOP-FOR FPE::READ-INSTRUCTION COMMON-LISP::COERCE ++ SYSTEM::SEQUENCE-CURSOR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMMON-LISP::FFLOOR SYSTEM::BREAK-FUNCTION ++ COMMON-LISP::APROPOS-LIST COMMON-LISP::DECODE-UNIVERSAL-TIME ++ SYSTEM::STEPPER COMMON-LISP::REQUIRE SYSTEM::APROPOS-DOC ++ SYSTEM::PRINT-DOC SYSTEM::INFO COMMON-LISP::USE-VALUE ++ COMMON-LISP::WRITE-TO-STRING COMMON-LISP::FCEILING ++ SYSTEM::GET-SETF-METHOD ++ ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE SYSTEM::NLOAD ++ COMMON-LISP::ENSURE-DIRECTORIES-EXIST ++ COMMON-LISP::WILD-PATHNAME-P COMMON-LISP::FTRUNCATE ++ COMMON-LISP::FROUND SYSTEM::PARSE-BODY-HEADER ++ COMMON-LISP::INVOKE-RESTART SYSTEM::SHOW-INFO ++ COMMON-LISP::READ-FROM-STRING ++ SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE COMMON-LISP::APROPOS ++ COMMON-LISP::STORE-VALUE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ ANSI-LOOP::LOOP-DO-WITH SYSTEM::WINE-TMP-REDIRECT ++ SLOOP::PARSE-ONE-WHEN-CLAUSE COMMON-LISP::TYPE-ERROR ++ SYSTEM::INSPECT-INDENT SYSTEM::SET-CURRENT SYSTEM::TEST-ERROR ++ SLOOP::LOOP-POP ANSI-LOOP::LOOP-DO-REPEAT ++ ANSI-LOOP::LOOP-GET-PROGN SYSTEM::DM-TOO-FEW-ARGUMENTS ++ ANSI-LOOP::LOOP-CONTEXT SYSTEM::READ-EVALUATED-FORM ++ SYSTEM::ALL-TRACE-DECLARATIONS ++ COMMON-LISP::LISP-IMPLEMENTATION-VERSION ++ SYSTEM::DEFAULT-SYSTEM-BANNER ANSI-LOOP::LOOP-DO-RETURN ++ SYSTEM::INSPECT-INDENT-1 SYSTEM::STEP-READ-LINE ++ SYSTEM::SET-ENV SYSTEM::DM-TOO-MANY-ARGUMENTS ++ ANSI-LOOP::LOOP-BIND-BLOCK SLOOP::PARSE-LOOP1 ++ ANSI-LOOP::LOOP-DO-NAMED SLOOP::PARSE-LOOP-COLLECT ++ SYSTEM::KCL-TOP-RESTARTS SYSTEM::INSPECT-READ-LINE ++ SYSTEM::SET-UP-TOP-LEVEL SYSTEM::SHOW-RESTARTS SYSTEM::DBL ++ SLOOP::PARSE-LOOP-FOR ANSI-LOOP::LOOP-ITERATION-DRIVER ++ ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ANSI-LOOP::LOOP-DO-DO ++ SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::GET-TEMP-DIR ++ ANSI-LOOP::LOOP-POP-SOURCE SLOOP::LOOP-UN-POP ++ SYSTEM::TOP-LEVEL ANSI-LOOP::LOOP-DO-FINALLY ++ ANSI-LOOP::LOOP-DO-INITIALLY SYSTEM::GET-INDEX-NODE ++ SYSTEM::SETUP-LINEINFO SLOOP::PARSE-LOOP-WHEN SYSTEM::CLEANUP ++ ANSI-LOOP::LOOP-GET-FORM SLOOP::PARSE-LOOP-DO ++ SYSTEM::INIT-BREAK-POINTS SLOOP::LOOP-PEEK ++ SYSTEM::GET-SIG-FN-NAME SYSTEM::ILLEGAL-BOA)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::SMALLNTHCDR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::THE-END ANSI-LOOP::DUPLICATABLE-CODE-P ++ SYSTEM::RELATIVE-LINE SYSTEM::GET-NODE-INDEX)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::ROUND-UP)) +\ No newline at end of file +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -68,7 +68,7 @@ sbrk1(n) + long starting_hole_div=10; + long starting_relb_heap_mult=2; + long new_holepage; +-long resv_pages=40; ++long resv_pages=0; + + #ifdef BSD + #include +@@ -186,14 +186,45 @@ int reserve_pages_for_signal_handler=30; + If not in_signal_handler then try to keep a minimum of + reserve_pages_for_signal_handler pages on hand in the hole + */ ++ ++inline void ++empty_relblock(void) { ++ ++ object o=sSAleaf_collection_thresholdA->s.s_dbind; ++ ++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(0); ++ for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;) ++ GBC(t_relocatable); ++ sSAleaf_collection_thresholdA->s.s_dbind=o; ++ ++} ++ ++inline void ++resize_hole(ufixnum hp,enum type tp) { ++ ++ char *new_start=heap_end+hp*PAGESIZE; ++ char *start=rb_pointer=start) || (new_start=start+size)) { ++ fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp); ++ fflush(stderr); ++ tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); ++ return resize_hole(hp,tp); ++ } ++ ++ holepage=hp; ++ tm_of(tp)->tm_adjgbccnt--; ++ GBC(tp); ++ ++} ++ + inline void * + alloc_page(long n) { + +- void *e=heap_end; + fixnum d,m; +-#ifdef SGC +- int in_sgc=sgc_enabled; +-#endif ++ + if (n>=0) { + + if (n>(holepage - (in_signal_handler? 0 : +@@ -215,25 +246,8 @@ eg to add 20 more do (si::set-hole-size + d=d<0 ? 0 : d; + d=new_holepagetm_type==t_relocatable,j=tm->tm_maxpage,z=(n-j)*(r ? 2 : 1); + if (z>available_pages) return 0; +- if (r && 2*n+page(REAL_RB_START)>real_maxpage) return 0; ++ if (r && 2*n+page(rb_start)>real_maxpage) return 0; + available_pages-=z; +- tm->tm_adjgbccnt*=((double)j)/n; ++ tm->tm_adjgbccnt*=((double)j+1)/(n+1); + tm->tm_maxpage=n; +- return n; ++ /* massert(!check_avail_pages()); */ ++ return 1; + } + + +@@ -317,8 +355,11 @@ add_page_to_freelist(char *p, struct typ + + if (sgc_enabled && tm->tm_sgc) + pp->sgc_flags=SGC_PAGE_FLAG; ++ ++#ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(pp->type)) + x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; ++#endif + + /* array headers must be always writable, since a write to the + body does not touch the header. It may be desirable if there +@@ -410,17 +451,61 @@ grow_linear(fixnum old, fixnum fract, fi + DEFVAR("*OPTIMIZE-MAXIMUM-PAGES*",sSAoptimize_maximum_pagesA,SI,sLnil,""); + #define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil) + DEFVAR("*NOTIFY-OPTIMIZE-MAXIMUM-PAGES*",sSAnotify_optimize_maximum_pagesA,SI,sLnil,""); +-#define MMAX_PG(a_) (a_)->tm_maxpage ++#define MMAX_PG(a_) (a_)->tm_maxpage-(a_)->tm_alt_npage ++ ++static int ++rebalance_maxpages(struct typemanager *my_tm,fixnum z) { ++ ++ fixnum d; ++ ufixnum i,j; ++ ++ ++ d=(z-my_tm->tm_maxpage)*(my_tm->tm_type==t_relocatable ? 2 : 1); ++ j=sum_maxpages(); ++ ++ if (j+d>phys_pages) { ++ ++ ufixnum k=0; ++ ++ for (i=t_start;ik+phys_pages-j ? k+phys_pages-j : d; ++ if (d<=0) ++ return 0; ++ ++ for (i=t_start;i((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage)) */ ++ /* return 0; */ ++ /* for (i=t_start;i0 && page(heap_end)-first_data_page+nrbpage>=phys_pages) +- return 0; ++ long mro=0,tro=0,j; + + if (page(core_end)>0.8*real_maxpage) + return 0; +@@ -437,22 +522,27 @@ opt_maxpage(struct typemanager *my_tm) { + } + #endif + +- z=my_tm->tm_adjgbccnt-1; ++ z=my_tm->tm_adjgbccnt/* -1 */; + z/=(1+x-0.9*my_tm->tm_adjgbccnt); + z*=(y-mmax_page)*mmax_page; + z=sqrt(z); + z=z-mmax_page>available_pages ? mmax_page+available_pages : z; +- my_tm->tm_opt_maxpage=(long)z>my_tm->tm_opt_maxpage ? (long)z : my_tm->tm_opt_maxpage; ++ my_tm->tm_opt_maxpage=(long)(z+my_tm->tm_alt_npage)>my_tm->tm_opt_maxpage ? (long)(z+my_tm->tm_alt_npage) : my_tm->tm_opt_maxpage; + + if (z<=mmax_page) + return 0; + + r=((x-my_tm->tm_adjgbccnt)+ my_tm->tm_adjgbccnt*mmax_page/z)*(y-mmax_page+z); + r/=x*y; ++ ++ j=r<=0.95 && rebalance_maxpages(my_tm,z+mro+my_tm->tm_alt_npage); ++ + if (sSAnotify_optimize_maximum_pagesA->s.s_dbind!=sLnil) +- printf("[type %u max %lu(%lu) opt %lu y %lu(%lu) gbcrat %f sav %f]\n", +- my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt-1)/(1+x-0.9*my_tm->tm_adjgbccnt),r); +- return r<=0.95 && set_tm_maxpage(my_tm,z+mro) ? 1 : 0; ++ printf("[type %u max %lu(%lu) opt %lu y %lu(%lu) gbcrat %f sav %f new %lu sum %lu phys %lu]\n", ++ my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt/* -1 */)/(1+x-0.9*my_tm->tm_adjgbccnt),r, ++ my_tm->tm_maxpage,sum_maxpages(),phys_pages); ++ ++ return j ? 1 : 0; + + } + +@@ -483,41 +573,200 @@ Use ALLOCATE to expand the space.", + #else + #define TOTAL_THIS_TYPE(tm) (tm->tm_nppage * tm->tm_npage) + #endif +-bool prefer_low_mem_contblock=FALSE; ++ ++static object cbv=Cnil; ++#define cbsrch1 ((struct contblock ***)cbv->v.v_self) ++#define cbsrche (cbsrch1+cbv->v.v_fillp) ++ ++static inline void ++expand_contblock_index_space(void) { ++ ++ if (cbv==Cnil) { ++ cbv=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(16),make_fixnum(aet_fix),Cnil,make_fixnum(0))); ++ cbv->v.v_self[0]=(object)&cb_pointer; ++ enter_mark_origin(&cbv); ++ } ++ ++ if (cbv->v.v_fillp+1==cbv->v.v_dim) { ++ ++ void *v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum)); ++ ++ memcpy(v,cbv->v.v_self,cbv->v.v_dim*sizeof(fixnum)); ++ cbv->v.v_self=v; ++ cbv->v.v_dim*=2; ++ ++ } ++ ++} ++ ++static inline void * ++expand_contblock_index(struct contblock ***cbppp) { ++ ++ ufixnum i=cbppp-cbsrch1; ++ ++ expand_contblock_index_space(); ++ ++ cbppp=cbsrch1+i; ++ memmove(cbppp+1,cbppp,(cbsrche-cbppp+1)*sizeof(*cbppp)); ++ cbv->v.v_fillp++; ++ ++ return cbppp; ++ ++} ++ ++static inline void ++contract_contblock_index(struct contblock ***cbppp) { ++ ++ memmove(cbppp+1,cbppp+2,(cbsrche-cbppp-1)*sizeof(*cbppp)); ++ cbv->v.v_fillp--; ++ ++} ++ ++static inline int ++cbcomp(const void *v1,const void *v2) { ++ ++ ufixnum u1=(**(struct contblock ** const *)v1)->cb_size; ++ ufixnum u2=(**(struct contblock ** const *)v2)->cb_size; ++ ++ return u1>1; ++ void *v=v1+nn*s; ++ int j=c(i,v); ++ ++ if (nn) ++ return !j ? v : (j>0 ? bsearchleq(i,v,n-nn,s,c) : bsearchleq(i,v1,nn,s,c)); ++ else ++ return j<=0 ? v : v+s; ++ ++} ++ ++ ++static inline struct contblock *** ++find_cbppp(struct contblock *cbp) { ++ ++ struct contblock **cbpp=&cbp; ++ ++ return cbsrche==cbsrch1 ? cbsrch1 : bsearchleq(&cbpp,cbsrch1,cbsrche-cbsrch1,sizeof(*cbsrch1),cbcomp); ++ ++} ++ ++static inline struct contblock *** ++find_cbppp_by_n(ufixnum n) { ++ ++ struct contblock cb={n,NULL}; ++ ++ return find_cbppp(&cb); ++ ++} ++ ++static inline struct contblock ** ++find_cbpp(struct contblock ***cbppp,ufixnum n) { ++ ++ return *cbppp; ++ ++} ++ ++ ++static inline struct contblock ** ++find_contblock(ufixnum n,void **p) { ++ ++ *p=find_cbppp_by_n(n); ++ return find_cbpp(*p,n); ++} ++ ++inline void ++print_cb(int print) { ++ ++ struct contblock *cbp,***cbppp,**cbpp=&cb_pointer; ++ ufixnum k; ++ ++ for (cbp=cb_pointer,cbppp=cbsrch1;cbp;cbppp++) { ++ massert(cbpppcb_size==(**cbppp)->cb_size;cbpp=&cbp->cb_link,cbp=cbp->cb_link,k++); ++ if (print) ++ fprintf(stderr,"%lu %p %p %lu %lu\n",cbppp-cbsrch1,*cbppp,**cbppp,(**cbppp)->cb_size,k); ++ } ++ massert(cbppp==cbsrche); ++ massert(*cbppp==cbpp); ++ massert(!**cbppp); ++ ++ fflush(stderr); ++ ++} ++ ++inline void ++insert_contblock(void *p,ufixnum s) { ++ ++ struct contblock *cbp=p,**cbpp,***cbppp; ++ ++ cbpp=find_contblock(s,(void **)&cbppp); ++ ++ cbp->cb_size=s; ++ cbp->cb_link=*cbpp; ++ *cbpp=cbp; ++ ++ if ((!cbp->cb_link || cbp->cb_link->cb_size!=s)) { ++ cbppp=expand_contblock_index(cbppp); ++ cbppp[1]=&cbp->cb_link; ++ } ++ ++} ++ ++static inline void ++delete_contblock(void *p,struct contblock **cbpp) { ++ ++ struct contblock ***cbppp=p; ++ ufixnum s=(*cbpp)->cb_size; ++ ++ (*cbpp)=(*cbpp)->cb_link; ++ ++ if ((!(*cbpp) || (*cbpp)->cb_size!=s)) ++ contract_contblock_index(cbppp); ++ ++} ++ ++inline void ++reset_contblock_freelist(void) { ++ ++ cb_pointer=NULL; ++ cbv->v.v_fillp=0; ++ ++} + + inline void * + alloc_from_freelist(struct typemanager *tm,fixnum n) { + +- void *p,*v,*vp; +- struct contblock **cbpp; +- fixnum i; ++ void *p; + + switch (tm->tm_type) { + + case t_contiguous: +- for (cbpp= &cb_pointer,v=(void *)-1,vp=NULL; (*cbpp)!=NULL; cbpp= &(*cbpp)->cb_link) +- if ((*cbpp)->cb_size >= n) { +- if (!prefer_low_mem_contblock) { +- vp=cbpp; +- break; +- } else if ((void *)(*cbpp)cb_size; ++ delete_contblock(pp,cbpp); ++ if (ncb_size-n; +- *cbpp=(*cbpp)->cb_link; +- --ncb; +- insert_contblock(p+n,i); +- return(p); ++ return p; + } + break; + + case t_relocatable: +- if (rb_limit-rb_pointer>=n) ++ if (rb_pointer>rb_end && rb_pointer+n>rb_limit && rb_pointer+nn) + return ((rb_pointer+=n)-n); + break; + +@@ -554,7 +803,7 @@ too_full_p(struct typemanager *tm) { + + switch (tm->tm_type) { + case t_relocatable: +- return 100*(rb_limit-rb_pointer)cb_link) k+=cbp->cb_size; +@@ -575,7 +824,7 @@ too_full_p(struct typemanager *tm) { + inline void * + alloc_after_gc(struct typemanager *tm,fixnum n) { + +- if (tm->tm_npage+tpage(tm,n)>=tm->tm_maxpage && GBC_enable) { ++ if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) { + + switch (jmp_gmp) { + case 0: /* not in gmp call*/ +@@ -618,11 +867,16 @@ add_pages(struct typemanager *tm,fixnum + + case t_relocatable: + ++ if (rb_pointer>rb_end) { ++ fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); ++ fflush(stderr); ++ GBC(t_relocatable); ++ } + nrbpage+=m; +- rb_end=heap_end+(holepage+nrbpage)*PAGESIZE; +- rb_limit=rb_end-2*RB_GETA; ++ rb_end+=m*PAGESIZE; ++ rb_limit+=m*PAGESIZE; + +- alloc_page(-(nrbpage+holepage)); ++ alloc_page(-(2*nrbpage+holepage)); + + break; + +@@ -656,7 +910,7 @@ alloc_after_adding_pages(struct typemana + + } + +- m=tm->tm_maxpage-tm->tm_npage; ++ /* m=tm->tm_maxpage-tm->tm_npage; */ + add_pages(tm,m); + + return alloc_from_freelist(tm,n); +@@ -670,15 +924,15 @@ alloc_after_reclaiming_pages(struct type + + if (tm->tm_type>=t_end) return NULL; + +- reloc_min=npage(rb_pointer-REAL_RB_START); ++ reloc_min=npage(rb_pointer-rb_start); + + if (m<2*(nrbpage-reloc_min)) { + + set_tm_maxpage(tm_table+t_relocatable,reloc_min); + nrbpage=reloc_min; + +- GBC(t_relocatable); + tm_table[t_relocatable].tm_adjgbccnt--; ++ GBC(t_relocatable); + + return alloc_after_adding_pages(tm,n); + +@@ -742,13 +996,31 @@ alloc_object(enum type t) { + + inline void * + alloc_contblock(size_t n) { +- return alloc_mem(tm_of(t_contiguous),ROUND_UP_PTR_CONT(n)); ++ return alloc_mem(tm_of(t_contiguous),CEI(n,CPTR_SIZE)); ++} ++ ++inline void * ++alloc_contblock_no_gc(size_t n) { ++ ++ struct typemanager *tm=tm_of(t_contiguous); ++ void *p; ++ ++ n=CEI(n,CPTR_SIZE); ++ ++ if ((p=alloc_from_freelist(tm,n))) ++ return p; ++ ++ if (tpage(tm,n)<(rb_start-heap_end)>>PAGEWIDTH && (p=alloc_after_adding_pages(tm,n))) ++ return p; ++ ++ return NULL; ++ + } + + inline void * + alloc_relblock(size_t n) { + +- return alloc_mem(tm_of(t_relocatable),ROUND_UP_PTR(n)); ++ return alloc_mem(tm_of(t_relocatable),CEI(n,PTR_ALIGN)); + + } + +@@ -789,7 +1061,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate + tm = & tm_table[tm->tm_type]; + if (tm->tm_type == t_relocatable) + { tm->tm_npage = (rb_end-rb_start)/PAGESIZE; +- tm->tm_nfree = rb_end -rb_pointer; ++ tm->tm_nfree = rb_limit -rb_pointer; + } + else if (tm->tm_type == t_contiguous) + { int cbfree =0; +@@ -808,45 +1080,6 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate + )); + } + +-/* DEFUN_NEW("RESET-NUMBER-USED",object,fSreset_number_used,SI,0,1,NONE,OO,OO,OO,OO,(object typ),"") */ +-/* {int i; */ +-/* if (VFUN_NARGS == 1) */ +-/* { tm_table[t_from_type(typ)].tm_nused = 0;} */ +-/* else */ +-/* for (i=0; i <= t_relocatable ; i++) */ +-/* { tm_table[i].tm_nused = 0;} */ +-/* RETURN1(sLnil); */ +-/* } */ +- +-#define IN_CONTBLOCK_P(p,pi) ((void *)p>=(void *)pi && (void *)p<(void *)pi+pi->in_use*PAGESIZE) +- +-/* SGC cont pages: explicit free calls can come at any time, and we +- must make sure to add the newly deallocated block to the right +- list. CM 20030827*/ +-#ifdef SGC +-void +-insert_maybe_sgc_contblock(char *p,int s) { +- +- struct contblock *tmp_cb_pointer; +- struct pageinfo *pi; +- +- for (pi=contblock_list_head;pi && !IN_CONTBLOCK_P(p,pi);pi=pi->next); +- massert(pi); +- +- if (sgc_enabled && ! (pi->sgc_flags&SGC_PAGE_FLAG)) { +- tmp_cb_pointer=cb_pointer; +- cb_pointer=old_cb_pointer; +- sgc_enabled=0; +- insert_contblock(p,s); +- sgc_enabled=1; +- old_cb_pointer=cb_pointer; +- cb_pointer=tmp_cb_pointer; +- } else +- insert_contblock(p,s); +- +-} +-#endif +- + #ifdef SGC_CONT_DEBUG + extern void overlap_check(struct contblock *,struct contblock *); + #endif +@@ -856,78 +1089,17 @@ DEFUN_NEW("PRINT-FREE-CONTBLOCK-LIST",ob + struct contblock *cbp,*cbp1; + + for (cbp=cb_pointer;cbp;cbp=cbp->cb_link) { +- printf("%p %d\n",cbp,cbp->cb_size); ++ printf("%p %lu\n",cbp,cbp->cb_size); + for (cbp1=cbp;cbp1;cbp1=cbp1->cb_link) + if ((void *)cbp+cbp->cb_size==(void *)cbp1 || + (void *)cbp1+cbp1->cb_size==(void *)cbp) +- printf(" adjacent to %p %d\n",cbp1,cbp1->cb_size); ++ printf(" adjacent to %p %lu\n",cbp1,cbp1->cb_size); + } + + return Cnil; + + } + +-void +-insert_contblock(char *p, int s) { +- +- struct contblock **cbpp, *cbp; +- +- /* SGC cont pages: This used to return when scb_size = ROUND_UP_PTR_CONT(s); +- +- for (cbpp=&cb_pointer;*cbpp;) { +- if ((void *)(*cbpp)+(*cbpp)->cb_size==(void *)cbp) { +- /* printf("Merge contblock %p %d %p %d\n",cbp,cbp->cb_size,*cbpp,(*cbpp)->cb_size); */ +- /* fflush(stdout); */ +- (*cbpp)->cb_size+=cbp->cb_size; +- cbp=*cbpp; +- *cbpp=(*cbpp)->cb_link; +- } else if ((void *)(*cbpp)==(void *)cbp+cbp->cb_size) { +- /* printf("Merge contblock %p %d %p %d\n",cbp,cbp->cb_size,*cbpp,(*cbpp)->cb_size); */ +- /* fflush(stdout); */ +- cbp->cb_size+=(*cbpp)->cb_size; +- *cbpp=(*cbpp)->cb_link; +- } else +- cbpp=&(*cbpp)->cb_link; +- } +- s=cbp->cb_size; +- +- for (cbpp = &cb_pointer; *cbpp; cbpp = &((*cbpp)->cb_link)) +- if ((*cbpp)->cb_size >= s) { +-#ifdef SGC_CONT_DEBUG +- if (*cbpp==cbp) { +- fprintf(stderr,"Trying to install a circle at %p\n",cbp); +- exit(1); +- } +- if (sgc_enabled) +- overlap_check(old_cb_pointer,cb_pointer); +-#endif +- cbp->cb_link = *cbpp; +- *cbpp = cbp; +-#ifdef SGC_CONT_DEBUG +- if (sgc_enabled) +- overlap_check(old_cb_pointer,cb_pointer); +-#endif +- return; +- } +- cbp->cb_link = NULL; +- *cbpp = cbp; +-#ifdef SGC_CONT_DEBUG +- if (sgc_enabled) +- overlap_check(old_cb_pointer,cb_pointer); +-#endif +- +-} +- + /* Add a tm_distinct field to prevent page type sharing if desired. + Not used now, as its never desirable from an efficiency point of + view, and as the only known place one must separate is cons and +@@ -961,7 +1133,7 @@ init_tm(enum type t, char *name, int els + return; + } + tm_table[(int)t].tm_type = t; +- tm_table[(int)t].tm_size = elsize ? ROUND_UP_PTR(elsize) : 1; ++ tm_table[(int)t].tm_size = elsize ? CEI(elsize,PTR_ALIGN) : 1; + tm_table[(int)t].tm_nppage = (PAGESIZE-sizeof(struct pageinfo))/tm_table[(int)t].tm_size; + tm_table[(int)t].tm_free = OBJNULL; + tm_table[(int)t].tm_nfree = 0; +@@ -1096,13 +1268,19 @@ gcl_init_alloc(void *cs_start) { + + update_real_maxpage(); + +- if (gcl_alloc_initialized) return; ++ if (gcl_alloc_initialized) { ++ massert(rb_start==heap_end &&rb_end==heap_end && rb_limit==heap_end && rb_pointer==heap_end); ++ holepage=new_holepage; ++ alloc_page(-holepage); ++ rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage< sizeof(baby_malloc_data)) + { +@@ -1642,11 +1821,11 @@ free(void *ptr) { + for (p = &malloc_list,pp=*p; pp && !endp(pp); p = &((pp)->c.c_cdr),pp=pp->c.c_cdr) + if ((pp)->c.c_car->st.st_self == ptr) { + /* SGC contblock pages: Its possible this is on an old page CM 20030827 */ +-#ifdef SGC +- insert_maybe_sgc_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); +-#else +- insert_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); +-#endif ++/* #ifdef SGC */ ++/* insert_maybe_sgc_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */ ++/* #else */ ++/* insert_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */ ++/* #endif */ + (pp)->c.c_car->st.st_self = NULL; + *p = pp->c.c_cdr; + #ifdef GCL_GPROF +@@ -1707,11 +1886,11 @@ realloc(void *ptr, size_t size) { + for (i = 0; i < size; i++) + x->st.st_self[i] = ((char *)ptr)[i]; + /* SGC contblock pages: Its possible this is on an old page CM 20030827 */ +-#ifdef SGC +- insert_maybe_sgc_contblock(ptr, j); +-#else +- insert_contblock(ptr, j); +-#endif ++/* #ifdef SGC */ ++/* insert_maybe_sgc_contblock(ptr, j); */ ++/* #else */ ++/* insert_contblock(ptr, j); */ ++/* #endif */ + return(x->st.st_self); + } + } +--- gcl-2.6.12.orig/o/array.c ++++ gcl-2.6.12/o/array.c +@@ -457,15 +457,15 @@ static longfloat DFLT_aet_lf = 0.0; + static object Iname_t = sLt; + static struct { char * dflt; object *namep;} aet_types[] = + { {(char *) &DFLT_aet_object, &Iname_t,}, /* t */ +- {(char *) &DFLT_aet_ch, &sLstring_char,},/* string-char */ ++ {(char *) &DFLT_aet_ch, &sLcharacter,},/* character */ + {(char *) &DFLT_aet_fix, &sLbit,}, /* bit */ + {(char *) &DFLT_aet_fix, &sLfixnum,}, /* fixnum */ + {(char *) &DFLT_aet_sf, &sLshort_float,}, /* short-float */ + {(char *) &DFLT_aet_lf, &sLlong_float,}, /* long-float */ +- {(char *) &DFLT_aet_char,&sLsigned_char,}, /* signed char */ +- {(char *) &DFLT_aet_char,&sLunsigned_char,}, /* unsigned char */ +- {(char *) &DFLT_aet_short,&sLsigned_short,}, /* signed short */ +- {(char *) &DFLT_aet_short, &sLunsigned_short}, /* unsigned short */ ++ {(char *) &DFLT_aet_char,&sSsigned_char,}, /* signed char */ ++ {(char *) &DFLT_aet_char,&sSunsigned_char,}, /* unsigned char */ ++ {(char *) &DFLT_aet_short,&sSsigned_short,}, /* signed short */ ++ {(char *) &DFLT_aet_short, &sSunsigned_short}, /* unsigned short */ + }; + + DEFUN_NEW("GET-AELTTYPE",object,fSget_aelttype,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") +--- gcl-2.6.12.orig/o/assignment.c ++++ gcl-2.6.12/o/assignment.c +@@ -172,7 +172,7 @@ DEFUNO_NEW("FSET",object,fSfset,SI + sym->s.s_mflag = FALSE; + } else if (car(function) == sLspecial) + FEerror("Cannot define a special form.", 0); +- else if (function->c.c_car == sLmacro) { ++ else if (function->c.c_car == sSmacro) { + sym->s.s_gfdef = function->c.c_cdr; + sym->s.s_mflag = TRUE; + } else { +--- gcl-2.6.12.orig/o/bind.c ++++ gcl-2.6.12/o/bind.c +@@ -918,8 +918,8 @@ parse_key_new_new(int n, object *base, s + /* from here down identical to parse_key_rest */ + new = new + n ; + {int j=keys->n; +- object *p= (object *)(keys->defaults); +- while (--j >=0) base[j]=p[j]; ++ object **p= (object **)(keys->defaults); ++ while (--j >=0) base[j]=*(p[j]); + } + {if (n==0){ return 0;} + {int allow = keys->allow_other_keys; +@@ -939,7 +939,7 @@ parse_key_new_new(int n, object *base, s + new = new -2; + k = *new; + while(--i >= 0) +- {if ((*(ke++)).o == k) ++ {if (*(*(ke++)).o == k) + {base[i]= new[1]; + n=n-2; + goto top; +@@ -1026,8 +1026,7 @@ parse_key_rest_new(object rest, int n, o + + new = new + n ; + {int j=keys->n; +- object *p= (object *)(keys->defaults); +- while (--j >=0) base[j]=p[j]; ++ while (--j >=0) base[j]=*keys->defaults[j].o; + } + {if (n==0){ return 0;} + {int allow = keys->allow_other_keys; +@@ -1047,7 +1046,7 @@ parse_key_rest_new(object rest, int n, o + new = new -2; + k = *new; + while(--i >= 0) +- {if ((*(ke++)).o == k) ++ {if (*(*(ke++)).o == k) + {base[i]= new[1]; + n=n-2; + goto top; +@@ -1066,18 +1065,19 @@ parse_key_rest_new(object rest, int n, o + return -1; + }}} + ++static object foo[2]={Cnil,OBJNULL}; + + void + set_key_struct(struct key *ks, object data) + {int i=ks->n; + while (--i >=0) +- {ks->keys[i].o = data->cfd.cfd_self[ ks->keys[i].i ]; ++ {ks->keys[i].o = data->cfd.cfd_self+ks->keys[i].i; + if (ks->defaults != (void *)Cstd_key_defaults) + {fixnum m=ks->defaults[i].i; + ks->defaults[i].o= +- (m==-2 ? Cnil : +- m==-1 ? OBJNULL : +- data->cfd.cfd_self[m]);} ++ (m==-2 ? foo : ++ m==-1 ? foo+1 : ++ data->cfd.cfd_self+m);} + }} + + #undef AUX +--- gcl-2.6.12.orig/o/cfun.c ++++ gcl-2.6.12/o/cfun.c +@@ -306,6 +306,15 @@ make_special_form_internal(char *s, void + return(x); + } + ++object ++make_si_special_form_internal(char *s, void (*f)()) ++{ ++ object x; ++ x = make_si_ordinary(s); ++ x->s.s_sfdef = f; ++ return(x); ++} ++ + DEFUN_NEW("COMPILED-FUNCTION-NAME",object,fScompiled_function_name,SI + ,1,1,NONE,OO,OO,OO,OO,(object fun),"") + +--- gcl-2.6.12.orig/o/character.d ++++ gcl-2.6.12/o/character.d +@@ -50,14 +50,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + @(return Cnil) + @) + +-@(defun string_char_p (c) +-@ +- check_type_character(&c); +- if (char_font(c) != 0 || char_bits(c) != 0) +- @(return Cnil) +- @(return Ct) +-@) +- + @(defun alpha_char_p (c) + int i; + @ +@@ -358,18 +350,6 @@ BEGIN: + @(return `make_fixnum(char_code(c))`) + @) + +-@(defun char_bits (c) +-@ +- check_type_character(&c); +- @(return `small_fixnum(char_bits(c))`) +-@) +- +-@(defun char_font (c) +-@ +- check_type_character(&c); +- @(return `small_fixnum(char_font(c))`) +-@) +- + @(defun code_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`)) + object x; + @ +@@ -393,29 +373,6 @@ BEGIN: + @(return x) + @) + +-@(defun make_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`)) +- object x; +- int code; +-@ +- check_type_character(&c); +- code = char_code(c); +- check_type_non_negative_integer(&b); +- check_type_non_negative_integer(&f); +- if (type_of(b) == t_bignum) +- @(return Cnil) +- if (type_of(f) == t_bignum) +- @(return Cnil) +- if (fix(b)>=CHBITSLIM || fix(f)>=CHFONTLIM) +- @(return Cnil) +- if (fix(b) == 0 && fix(f) == 0) +- @(return `code_char(code)`) +- x = alloc_object(t_character); +- char_code(x) = code; +- char_bits(x) = fix(b); +- char_font(x) = fix(f); +- @(return x) +-@) +- + @(defun char_upcase (c) + @ + check_type_character(&c); +@@ -489,30 +446,6 @@ int w, r; + @(return `make_fixnum(i)`) + @) + +-@(defun int_char (x) +- int i, c, b, f; +-@ +- check_type_non_negative_integer(&x); +- if (type_of(x) == t_bignum) +- @(return Cnil) +- i = fix(x); +- c = i % CHCODELIM; +- i /= CHCODELIM; +- b = i % CHBITSLIM; +- i /= CHBITSLIM; +- f = i % CHFONTLIM; +- i /= CHFONTLIM; +- if (i > 0) +- @(return Cnil) +- if (b == 0 && f == 0) +- @(return `code_char(c)`) +- x = alloc_object(t_character); +- char_code(x) = c; +- char_bits(x) = b; +- char_font(x) = f; +- @(return x) +-@) +- + @(defun char_name (c) + @ + check_type_character(&c); +@@ -563,18 +496,6 @@ int w, r; + @(return Cnil) + @) + +-@(defun char_bit (c n) +-@ +- check_type_character(&c); +- FEerror("Cannot get char-bit of ~S.", 1, c); +-@) +- +-@(defun set_char_bit (c n v) +-@ +- check_type_character(&c); +- FEerror("Cannot set char-bit of ~S.", 1, c); +-@) +- + void + gcl_init_character() + { +@@ -599,8 +520,8 @@ gcl_init_character() + #endif + + make_constant("CHAR-CODE-LIMIT", make_fixnum(CHCODELIM)); +- make_constant("CHAR-FONT-LIMIT", make_fixnum(CHFONTLIM)); +- make_constant("CHAR-BITS-LIMIT", make_fixnum(CHBITSLIM)); ++ make_si_constant("CHAR-FONT-LIMIT", make_fixnum(CHFONTLIM)); ++ make_si_constant("CHAR-BITS-LIMIT", make_fixnum(CHBITSLIM)); + + STreturn = make_simple_string("Return"); + enter_mark_origin(&STreturn); +@@ -620,18 +541,97 @@ gcl_init_character() + STnewline = make_simple_string("Newline"); + enter_mark_origin(&STnewline); + +- make_constant("CHAR-CONTROL-BIT", make_fixnum(0)); +- make_constant("CHAR-META-BIT", make_fixnum(0)); +- make_constant("CHAR-SUPER-BIT", make_fixnum(0)); +- make_constant("CHAR-HYPER-BIT", make_fixnum(0)); ++ make_si_constant("CHAR-CONTROL-BIT", make_fixnum(0)); ++ make_si_constant("CHAR-META-BIT", make_fixnum(0)); ++ make_si_constant("CHAR-SUPER-BIT", make_fixnum(0)); ++ make_si_constant("CHAR-HYPER-BIT", make_fixnum(0)); ++ + } + ++@(defun make_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`)) ++ object x; ++ int code; ++@ ++ check_type_character(&c); ++ code = char_code(c); ++ check_type_non_negative_integer(&b); ++ check_type_non_negative_integer(&f); ++ if (type_of(b) == t_bignum) ++ @(return Cnil) ++ if (type_of(f) == t_bignum) ++ @(return Cnil) ++ if (fix(b)>=CHBITSLIM || fix(f)>=CHFONTLIM) ++ @(return Cnil) ++ if (fix(b) == 0 && fix(f) == 0) ++ @(return `code_char(code)`) ++ x = alloc_object(t_character); ++ char_code(x) = code; ++ char_bits(x) = fix(b); ++ char_font(x) = fix(f); ++ @(return x) ++@) ++ ++@(defun char_bits (c) ++@ ++ check_type_character(&c); ++ @(return `small_fixnum(char_bits(c))`) ++@) ++ ++@(defun char_font (c) ++@ ++ check_type_character(&c); ++ @(return `small_fixnum(char_font(c))`) ++@) ++ ++@(defun char_bit (c n) ++@ ++ check_type_character(&c); ++ FEerror("Cannot get char-bit of ~S.", 1, c); ++@) ++ ++@(defun set_char_bit (c n v) ++@ ++ check_type_character(&c); ++ FEerror("Cannot set char-bit of ~S.", 1, c); ++@) ++ ++@(defun string_char_p (c) ++@ ++ check_type_character(&c); ++ if (char_font(c) != 0 || char_bits(c) != 0) ++ @(return Cnil) ++ @(return Ct) ++@) ++ ++@(defun int_char (x) ++ int i, c, b, f; ++@ ++ check_type_non_negative_integer(&x); ++ if (type_of(x) == t_bignum) ++ @(return Cnil) ++ i = fix(x); ++ c = i % CHCODELIM; ++ i /= CHCODELIM; ++ b = i % CHBITSLIM; ++ i /= CHBITSLIM; ++ f = i % CHFONTLIM; ++ i /= CHFONTLIM; ++ if (i > 0) ++ @(return Cnil) ++ if (b == 0 && f == 0) ++ @(return `code_char(c)`) ++ x = alloc_object(t_character); ++ char_code(x) = c; ++ char_bits(x) = b; ++ char_font(x) = f; ++ @(return x) ++@) ++ + void + gcl_init_character_function() + { + make_function("STANDARD-CHAR-P", Lstandard_char_p); + make_function("GRAPHIC-CHAR-P", Lgraphic_char_p); +- make_function("STRING-CHAR-P", Lstring_char_p); + make_function("ALPHA-CHAR-P", Lalpha_char_p); + make_function("UPPER-CASE-P", Lupper_case_p); + make_function("LOWER-CASE-P", Llower_case_p); +@@ -652,17 +652,18 @@ gcl_init_character_function() + make_function("CHAR-NOT-LESSP", Lchar_not_lessp); + make_function("CHARACTER", Lcharacter); + make_function("CHAR-CODE", Lchar_code); +- make_function("CHAR-BITS", Lchar_bits); +- make_function("CHAR-FONT", Lchar_font); + make_function("CODE-CHAR", Lcode_char); +- make_function("MAKE-CHAR", Lmake_char); + make_function("CHAR-UPCASE", Lchar_upcase); + make_function("CHAR-DOWNCASE", Lchar_downcase); + make_function("DIGIT-CHAR", Ldigit_char); + make_function("CHAR-INT", Lchar_int); +- make_function("INT-CHAR", Lint_char); + make_function("CHAR-NAME", Lchar_name); + make_function("NAME-CHAR", Lname_char); +- make_function("CHAR-BIT", Lchar_bit); +- make_function("SET-CHAR-BIT", Lset_char_bit); ++ make_si_function("INT-CHAR", Lint_char); ++ make_si_function("MAKE-CHAR", Lmake_char); ++ make_si_function("CHAR-BITS", Lchar_bits); ++ make_si_function("CHAR-FONT", Lchar_font); ++ make_si_function("CHAR-BIT", Lchar_bit); ++ make_si_function("SET-CHAR-BIT", Lset_char_bit); ++ make_si_function("STRING-CHAR-P", Lstring_char_p); + } +--- gcl-2.6.12.orig/o/cmpaux.c ++++ gcl-2.6.12/o/cmpaux.c +@@ -48,7 +48,7 @@ DEFUNO_NEW("SPECIALP",object,fSspecialp, + RETURN1(sym); + } + +-DEF_ORDINARY("DEBUG",sSdebug,SI,""); ++DEF_ORDINARY("DEBUGGER",sSdebugger,SI,""); + + DEFUN_NEW("DEFVAR1",object,fSdefvar1,SI + ,2,3,NONE,OO,OO,OO,OO,(object sym,object val,...),"") +@@ -71,10 +71,10 @@ DEFUN_NEW("DEFVAR1",object,fSdefvar1,SI + } + + +-DEFUN_NEW("DEBUG",object,fSdebug,SI ++DEFUN_NEW("DEBUG",object,fLdebug,LISP + ,2,2,NONE,OO,OO,OO,OO,(object sym,object val),"") + { /* 2 args */ +- putprop(sym,val,sSdebug); ++ putprop(sym,val,sSdebugger); + RETURN1(sym); + } + +--- gcl-2.6.12.orig/o/error.c ++++ gcl-2.6.12/o/error.c +@@ -67,27 +67,27 @@ ihs_function_name(object x) + y = x->c.c_car; + if (y == sLlambda) + return(sLlambda); +- if (y == sLlambda_closure) +- return(sLlambda_closure); +- if (y == sLlambda_block || y == sSlambda_block_expanded) { ++ if (y == sSlambda_closure) ++ return(sSlambda_closure); ++ if (y == sSlambda_block || y == sSlambda_block_expanded) { + x = x->c.c_cdr; + if (type_of(x) != t_cons) +- return(sLlambda_block); ++ return(sSlambda_block); + return(x->c.c_car); + } +- if (y == sLlambda_block_closure) { ++ if (y == sSlambda_block_closure) { + x = x->c.c_cdr; + if (type_of(x) != t_cons) +- return(sLlambda_block_closure); ++ return(sSlambda_block_closure); + x = x->c.c_cdr; + if (type_of(x) != t_cons) +- return(sLlambda_block_closure); ++ return(sSlambda_block_closure); + x = x->c.c_cdr; + if (type_of(x) != t_cons) +- return(sLlambda_block_closure); ++ return(sSlambda_block_closure); + x = x->c.c_cdr; + if (type_of(x) != t_cons) +- return(sLlambda_block_closure); ++ return(sSlambda_block_closure); + return(x->c.c_car); + } + /* a general special form */ +--- gcl-2.6.12.orig/o/eval.c ++++ gcl-2.6.12/o/eval.c +@@ -227,7 +227,7 @@ funcall(object fun) + c = FALSE; + fun = fun->c.c_cdr; + +- }else if (x == sLlambda_block) { ++ }else if (x == sSlambda_block) { + b = TRUE; + c = FALSE; + if(sSlambda_block_expanded->s.s_dbind!=OBJNULL) +@@ -237,14 +237,14 @@ funcall(object fun) + + + +- } else if (x == sLlambda_closure) { ++ } else if (x == sSlambda_closure) { + b = FALSE; + c = TRUE; + fun = fun->c.c_cdr; + } else if (x == sLlambda) { + b = c = FALSE; + fun = fun->c.c_cdr; +- } else if (x == sLlambda_block_closure) { ++ } else if (x == sSlambda_block_closure) { + b = c = TRUE; + fun = fun->c.c_cdr; + } else +@@ -644,13 +644,13 @@ EVAL: + + vs_check; + +- if (Vevalhook->s.s_dbind != Cnil && eval1 == 0) ++ if (siVevalhook->s.s_dbind != Cnil && eval1 == 0) + { + bds_ptr old_bds_top = bds_top; +- object hookfun = symbol_value(Vevalhook); ++ object hookfun = symbol_value(siVevalhook); + /* check if Vevalhook is unbound */ + +- bds_bind(Vevalhook, Cnil); ++ bds_bind(siVevalhook, Cnil); + form = Ifuncall_n(hookfun,2,form,list(3,lex_env[0],lex_env[1],lex_env[2])); + bds_unwind(old_bds_top); + return form; +@@ -721,7 +721,7 @@ APPLICATION: + for (x = lex_env[1]; type_of(x) == t_cons; x = x->c.c_cdr) + if (x->c.c_car->c.c_car == fun) { + x = x->c.c_car; +- if (MMcadr(x) == sLmacro) { ++ if (MMcadr(x) == sSmacro) { + x = MMcaddr(x); + goto EVAL_MACRO; + } +@@ -755,10 +755,10 @@ EVAL_ARGS: + vs_top = ++top; + form = MMcdr(form);} + n =top - base; /* number of args */ +- if (Vapplyhook->s.s_dbind != Cnil) { ++ if (siVapplyhook->s.s_dbind != Cnil) { + base[0]= (object)n; + base[0] = c_apply_n(list,n+1,base); +- x = Ifuncall_n(Vapplyhook->s.s_dbind,3, ++ x = Ifuncall_n(siVapplyhook->s.s_dbind,3, + x, /* the function */ + base[0], /* the arg list */ + list(3,lex_env[0],lex_env[1],lex_env[2])); +@@ -775,7 +775,7 @@ EVAL_ARGS: + + LAMBDA: + if (type_of(fun) == t_cons && MMcar(fun) == sLlambda) { +- x = listA(4,sLlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun)); ++ x = listA(4,sSlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun)); + goto EVAL_ARGS; + } + FEinvalid_function(fun); +@@ -805,13 +805,13 @@ EVAL: + + vs_check; + +- if (Vevalhook->s.s_dbind != Cnil && eval1 == 0) ++ if (siVevalhook->s.s_dbind != Cnil && eval1 == 0) + { + bds_ptr old_bds_top = bds_top; +- object hookfun = symbol_value(Vevalhook); +- /* check if Vevalhook is unbound */ ++ object hookfun = symbol_value(siVevalhook); ++ /* check if siVevalhook is unbound */ + +- bds_bind(Vevalhook, Cnil); ++ bds_bind(siVevalhook, Cnil); + vs_base = vs_top; + vs_push(form); + vs_push(lex_env[0]); +@@ -903,7 +903,7 @@ APPLICATION: + for (x = lex_env[1]; type_of(x) == t_cons; x = x->c.c_cdr) + if (x->c.c_car->c.c_car == fun) { + x = x->c.c_car; +- if (MMcadr(x) == sLmacro) { ++ if (MMcadr(x) == sSmacro) { + x = MMcaddr(x); + goto EVAL_MACRO; + } +@@ -940,7 +940,7 @@ EVAL_ARGS: + form = MMcdr(form); + } + vs_base = base; +- if (Vapplyhook->s.s_dbind != Cnil) { ++ if (siVapplyhook->s.s_dbind != Cnil) { + call_applyhook(fun); + return; + } +@@ -959,7 +959,7 @@ LAMBDA: + temporary = make_cons(lex_env[2], fun->c.c_cdr); + temporary = make_cons(lex_env[1], temporary); + temporary = make_cons(lex_env[0], temporary); +- x = make_cons(sLlambda_closure, temporary); ++ x = make_cons(sSlambda_closure, temporary); + vs_push(x); + goto EVAL_ARGS; + } +@@ -972,7 +972,7 @@ call_applyhook(object fun) + object ah; + object *v; + +- ah = symbol_value(Vapplyhook); ++ ah = symbol_value(siVapplyhook); + v = vs_base + 1; + vs_push(Cnil); + while (vs_top > v) +@@ -1040,7 +1040,7 @@ DEFUNOM_NEW("EVAL",object,fLeval,LISP + return Ivs_values(); + } + +-LFD(Levalhook)(void) ++LFD(siLevalhook)(void) + { + object env; + bds_ptr old_bds_top = bds_top; +@@ -1062,15 +1062,15 @@ LFD(Levalhook)(void) + vs_push(car(env)); + } else + too_many_arguments(); +- bds_bind(Vevalhook, vs_base[1]); +- bds_bind(Vapplyhook, vs_base[2]); ++ bds_bind(siVevalhook, vs_base[1]); ++ bds_bind(siVapplyhook, vs_base[2]); + eval1 = 1; + eval(vs_base[0]); + lex_env = lex; + bds_unwind(old_bds_top); + } + +-LFD(Lapplyhook)(void) ++LFD(siLapplyhook)(void) + { + + object env; +@@ -1094,8 +1094,8 @@ LFD(Lapplyhook)(void) + vs_push(car(env)); + } else + too_many_arguments(); +- bds_bind(Vevalhook, vs_base[2]); +- bds_bind(Vapplyhook, vs_base[3]); ++ bds_bind(siVevalhook, vs_base[2]); ++ bds_bind(siVapplyhook, vs_base[3]); + z = vs_top; + for (l = vs_base[1]; !endp(l); l = l->c.c_cdr) + vs_push(l->c.c_car); +@@ -1392,15 +1392,15 @@ gcl_init_eval(void) + make_constant("CALL-ARGUMENTS-LIMIT", make_fixnum(64)); + + +- Vevalhook = make_special("*EVALHOOK*", Cnil); +- Vapplyhook = make_special("*APPLYHOOK*", Cnil); ++ siVevalhook = make_si_special("*EVALHOOK*", Cnil); ++ siVapplyhook = make_si_special("*APPLYHOOK*", Cnil); + + + three_nils.nil3_self[0] = Cnil; + three_nils.nil3_self[1] = Cnil; + three_nils.nil3_self[2] = Cnil; + +- make_function("EVALHOOK", Levalhook); +- make_function("APPLYHOOK", Lapplyhook); ++ make_si_function("EVALHOOK", siLevalhook); ++ make_si_function("APPLYHOOK", siLapplyhook); + + } +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -345,14 +345,14 @@ getd(str) + #define READ_BYTE1() getc(fas_stream) + + #define GET8(varx ) \ +- do{unsigned long var=(unsigned long)READ_BYTE1(); \ +- var |= ((unsigned long)READ_BYTE1() << SIZE_BYTE); \ +- var |= ((unsigned long)READ_BYTE1() << (2*SIZE_BYTE)); \ +- var |= ((unsigned long)READ_BYTE1() << (3*SIZE_BYTE)); \ +- var |= ((unsigned long)READ_BYTE1() << (4*SIZE_BYTE)); \ +- var |= ((unsigned long)READ_BYTE1() << (5*SIZE_BYTE)); \ +- var |= ((unsigned long)READ_BYTE1() << (6*SIZE_BYTE)); \ +- var |= ((unsigned long)READ_BYTE1() << (7*SIZE_BYTE)); \ ++ do{unsigned long long var=READ_BYTE1(); \ ++ var |= ((unsigned long long)READ_BYTE1() << SIZE_BYTE); \ ++ var |= ((unsigned long long)READ_BYTE1() << (2*SIZE_BYTE)); \ ++ var |= ((unsigned long long)READ_BYTE1() << (3*SIZE_BYTE)); \ ++ var |= ((unsigned long long)READ_BYTE1() << (4*SIZE_BYTE)); \ ++ var |= ((unsigned long long)READ_BYTE1() << (5*SIZE_BYTE)); \ ++ var |= ((unsigned long long)READ_BYTE1() << (6*SIZE_BYTE)); \ ++ var |= ((unsigned long long)READ_BYTE1() << (7*SIZE_BYTE)); \ + DPRINTF("{8byte:varx= %ld}", var); \ + varx=var;} while (0) + +@@ -386,7 +386,7 @@ getd(str) + #define GETFIX(v_) Join(GET,SIZEOF_LONG)(v_) + + #define PUT8(varx ) \ +- do{unsigned long var= varx ; \ ++ do{unsigned long long var= varx ; \ + DPRINTF("{8byte:varx= %ld}", var); \ + WRITE_BYTEI(var,0); \ + WRITE_BYTEI(var,1); \ +@@ -808,7 +808,7 @@ write_fasd(object obj) + {int l = MP(obj)->_mp_size; + int m = (l >= 0 ? l : -l); + +- unsigned long *u = (unsigned long *) MP(obj)->_mp_d; ++ mp_limb_t *u = MP(obj)->_mp_d; + /* fix this */ + /* if (sizeof(mp_limb_t) != 4) { FEerror("fix for gmp",0);} */ + PUT4(l); +@@ -1279,7 +1279,7 @@ read_fasd1(int i, object *loc) + case DP( d_bignum:) + {int j,m; + object tem; +- unsigned long *u; ++ mp_limb_t *u; + GET4(j); + #ifdef GMP + tem = new_bignum(); +@@ -1287,7 +1287,7 @@ read_fasd1(int i, object *loc) + _mpz_realloc(MP(tem),m); + MP(tem)->_mp_size = j; + j = m; +- u = (unsigned long *) MP(tem)->_mp_d; ++ u = MP(tem)->_mp_d; + #else + { BEGIN_NO_INTERRUPT; + tem = alloc_object(t_bignum); +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -268,7 +268,7 @@ BEGIN: + return(strm->sm.sm_object0); + + case smm_socket: +- return (sLstring_char); ++ return (sLcharacter); + + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); +@@ -295,10 +295,10 @@ BEGIN: + return(stream_element_type(STREAM_INPUT_STREAM(strm))); + + case smm_string_input: +- return(sLstring_char); ++ return(sLcharacter); + + case smm_string_output: +- return(sLstring_char); ++ return(sLcharacter); + + default: + error("illegal stream mode"); +@@ -512,7 +512,7 @@ object if_exists, if_does_not_exist; + x->sm.sm_fp = fp; + + x->sm.sm_buffer = 0; +- x->sm.sm_object0 = (unzipped ? make_cons(sSAallow_gzipped_fileA,unzipped) : sLstring_char); ++ x->sm.sm_object0 = (unzipped ? make_cons(sSAallow_gzipped_fileA,unzipped) : sLcharacter); + x->sm.sm_object1 = fn; + x->sm.sm_int0 = x->sm.sm_int1 = 0; + vs_push(x); +@@ -1715,7 +1715,7 @@ LFD(Lstream_element_type)() + + @(static defun open (filename + &key (direction sKinput) +- (element_type sLstring_char) ++ (element_type sLcharacter) + (if_exists Cnil iesp) + (if_does_not_exist Cnil idnesp) + &aux strm) +@@ -1800,7 +1800,7 @@ LFD(Lfile_length)() + vs_base[0] = make_fixnum(i); + } + +-object sSAload_pathnameA; ++object sLAload_pathnameA; + DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,""); + DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,""); + +@@ -1861,7 +1861,7 @@ DEFVAR("*BINARY-MODULES*",sSAbinary_modu + } + package = symbol_value(sLApackageA); + bds_bind(sLApackageA, package); +- bds_bind(sSAload_pathnameA,fasl_filename); ++ bds_bind(sLAload_pathnameA,fasl_filename); + if (sSAcollect_binary_modulesA->s.s_dbind==Ct) { + object _x=sSAbinary_modulesA->s.s_dbind; + object _y=Cnil; +@@ -1920,7 +1920,7 @@ DEFVAR("*BINARY-MODULES*",sSAbinary_modu + flush_stream(PRINTstream); + } + package = symbol_value(sLApackageA); +- bds_bind(sSAload_pathnameA,pathname); ++ bds_bind(sLAload_pathnameA,pathname); + bds_bind(sLApackageA, package); + bds_bind(sLAstandard_inputA, strm); + frs_push(FRS_PROTECT, Cnil); +@@ -2534,7 +2534,7 @@ gcl_init_file(void) + standard_input->sm.sm_mode = (short)smm_input; + standard_input->sm.sm_fp = stdin; + standard_input->sm.sm_buffer = 0; +- standard_input->sm.sm_object0 = sLstring_char; ++ standard_input->sm.sm_object0 = sLcharacter; + standard_input->sm.sm_object1 + #ifdef UNIX + = make_simple_string("stdin"); +@@ -2546,7 +2546,7 @@ gcl_init_file(void) + standard_output->sm.sm_mode = (short)smm_output; + standard_output->sm.sm_fp = stdout; + standard_output->sm.sm_buffer = 0; +- standard_output->sm.sm_object0 = sLstring_char; ++ standard_output->sm.sm_object0 = sLcharacter; + standard_output->sm.sm_object1 + #ifdef UNIX + = make_simple_string("stdout"); +@@ -2571,7 +2571,7 @@ gcl_init_file(void) + } + + DEFVAR("*IGNORE-EOF-ON-TERMINAL-IO*",sSAignore_eof_on_terminal_ioA,SI,Cnil,""); +-DEFVAR("*LOAD-PATHNAME*",sSAload_pathnameA,SI,Cnil,""); ++DEFVAR("*LOAD-PATHNAME*",sLAload_pathnameA,LISP,Cnil,""); + DEFVAR("*LOAD-VERBOSE*",sLAload_verboseA,LISP,Ct,""); + + DEF_ORDINARY("ABORT",sKabort,KEYWORD,""); +--- gcl-2.6.12.orig/o/funlink.c ++++ gcl-2.6.12/o/funlink.c +@@ -19,7 +19,7 @@ typedef object (*object_func)(); + static int + vpush_extend(void *,object); + +-object sLAlink_arrayA; ++object sSAlink_arrayA; + int Rset = 0; + + DEFVAR("*LINK-LIST*",sSAlink_listA,SI,0,""); +@@ -67,8 +67,8 @@ call_or_link(object sym, void **link) { + if (Rset==0) + funcall(fun); + else if (type_of(fun) == t_cfun) { +- (void) vpush_extend( link,sLAlink_arrayA->s.s_dbind); +- (void) vpush_extend( *link,sLAlink_arrayA->s.s_dbind); ++ (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind); ++ (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind); + *link = (void *) (fun->cf.cf_self); + (*(void (*)())(fun->cf.cf_self))(); + } else { +@@ -89,8 +89,8 @@ call_or_link_closure(object sym, void ** + } + if (type_of(fun) == t_cclosure && (fun->cc.cc_turbo)) { + if (Rset) { +- (void) vpush_extend( link,sLAlink_arrayA->s.s_dbind); +- (void) vpush_extend( *link,sLAlink_arrayA->s.s_dbind); ++ (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind); ++ (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind); + *ptr = (void *)fun; + *link = (void *) (fun->cf.cf_self); + MMccall(fun); +@@ -105,8 +105,8 @@ call_or_link_closure(object sym, void ** + /* can't do this if invoking foo(a) is illegal when foo is not defined + to take any arguments. In the majority of C's this is legal */ + else if (type_of(fun) == t_cfun) { +- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind); +- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind); ++ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind); ++ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind); + *link = (void *)fun->cf.cf_self; + (*(void (*)())fun->cf.cf_self)(); + } else { +@@ -129,7 +129,7 @@ vpush_extend(void *item, object ar) + return(ar->v.v_fillp = ind);} + else + { +- int newdim= ROUND_UP_PTR((2 + (int) (1.3 * ind))); ++ int newdim= CEI((2 + (int) (1.3 * ind)),PTR_ALIGN); + unsigned char *newself; + newself = (void *)alloc_relblock(newdim); + bcopy(ar->ust.ust_self,newself,ind); +@@ -180,8 +180,8 @@ is supplied and FLAG is nil, then this f + LDEFAULT2: sym = Cnil ; + LEND_VARARG: va_end(ap);} + +- if (sLAlink_arrayA ==0) RETURN1(Cnil); +- link_ar = sLAlink_arrayA->s.s_dbind; ++ if (sSAlink_arrayA ==0) RETURN1(Cnil); ++ link_ar = sSAlink_arrayA->s.s_dbind; + if (link_ar==Cnil && flag==Cnil) RETURN1(Cnil); + check_type_array(&link_ar); + if (type_of(link_ar) != t_string) +@@ -339,8 +339,8 @@ call_proc(object sym, void **link, int a + + } + +- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind); +- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind); ++ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind); ++ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind); + *link = (void *)fn; + + AFTER_LINK: +@@ -443,8 +443,8 @@ call_proc_new(object sym, void **link, i + + } + +- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind); +- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind); ++ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind); ++ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind); + *link = (void *)fn; + + AFTER_LINK: +@@ -607,7 +607,7 @@ FFN(mv_ref)(unsigned int i) + #include "xdrfuns.c" + + DEF_ORDINARY("CDEFN",sScdefn,SI,""); +-DEFVAR("*LINK-ARRAY*",sLAlink_arrayA,LISP,Cnil,""); ++DEFVAR("*LINK-ARRAY*",sSAlink_arrayA,SI,Cnil,""); + + void + gcl_init_links(void) +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -24,7 +24,7 @@ + IMPLEMENTATION-DEPENDENT + */ + +-#define DEBUG ++/* #define DEBUG */ + + #define IN_GBC + #define NEED_MP_H +@@ -45,7 +45,7 @@ static void + sgc_mark_phase(void); + + static fixnum +-sgc_count_writable(void); ++sgc_count_read_only(void); + + #endif + +@@ -55,10 +55,6 @@ mark_c_stack(jmp_buf, int, void (*)(void + static void + mark_contblock(void *, int); + +-static void +-mark_object(object); +- +- + /* the following in line definitions seem to be twice as fast (at + least on mc68020) as going to the assembly function calls in bitop.c so + since this is more portable and faster lets use them --W. Schelter +@@ -75,6 +71,31 @@ mark_object(object); + #error Do not recognize CPTR_SIZE + #endif + ++void * ++cb_in(void *p) { ++ struct contblock **cbpp; ++ int i; ++ ++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) { ++ if ((void *)*cbpp<=p && ((void *)(*cbpp)+(*cbpp)->cb_size) >p) ++ return *cbpp; ++ } ++ return NULL; ++} ++ ++int ++cb_print(void) { ++ struct contblock **cbpp; ++ int i; ++ ++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) { ++ fprintf(stderr,"%lu at %p\n",(*cbpp)->cb_size,*cbpp); ++ fflush(stderr); ++ } ++ fprintf(stderr,"%u blocks\n",i); ++ return 0; ++} ++ + #ifdef CONTBLOCK_MARK_DEBUG + int + cb_check(void) { +@@ -121,13 +142,48 @@ off_check(void *v,void *ve,fixnum i,stru + } + #endif + ++void **contblock_stack_list=NULL; ++ ++static inline bool ++pageinfo_p(void *v) { ++ ++ struct pageinfo *pi=v; ++ ++ return pi->magic==PAGE_MAGIC && pi->type<=t_contiguous && ++ (!pi->next || (void *)pi->next>=v+(pi->type==t_contiguous ? pi->in_use : 1)*PAGESIZE); ++ ++} ++ ++static inline bool ++in_contblock_stack_list(void *p,void ***ap) { ++ void **a; ++ for (a=*ap;a && a[0]>p;a=a[1]); ++ *ap=a; ++ /* if (a && a[0]==p) fprintf(stderr,"Skipping %p\n",p); */ ++ return a && a[0]==p; ++} + + inline struct pageinfo * + get_pageinfo(void *x) { +- struct pageinfo *v=contblock_list_head;void *vv; +- for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next); +- return v; ++ ++ void *p=pageinfo(x),**a=contblock_stack_list; ++ struct pageinfo *v; ++ ++ for (;!pageinfo_p(p) || in_contblock_stack_list(p,&a);p-=PAGESIZE); ++ ++ v=p; ++ massert(v->type==t_contiguous && p+v->in_use*PAGESIZE>x); ++ ++ return p; ++ + } ++ ++/* inline struct pageinfo * */ ++/* get_pageinfo(void *x) { */ ++/* struct pageinfo *v=contblock_list_head;void *vv; */ ++/* for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next); */ ++/* return v; */ ++/* } */ + + inline char + get_bit(char *v,struct pageinfo *pi,void *x) { +@@ -300,21 +356,6 @@ enter_mark_origin(object *p) { + + } + +-inline void +-mark_cons(object x) { +- +- do { +- object d=x->c.c_cdr; +- mark(x); +- mark_object(x->c.c_car); +- x=d; +- if (NULL_OR_ON_C_STACK(x) || is_marked_or_free(x))/*catches Cnil*/ +- return; +- } while (cdr_listp(x)); +- mark_object(x); +- +-} +- + /* Whenever two arrays are linked together by displacement, + if one is live, the other will be made live */ + #define mark_displaced_field(ar) mark_object(ar->a.a_displaced) +@@ -336,27 +377,17 @@ mark_link_array(void *v,void *ve) { + if (NULL_OR_ON_C_STACK(v)) + return; + +- if (sLAlink_arrayA->s.s_dbind==Cnil) ++ if (sSAlink_arrayA->s.s_dbind==Cnil) + return; + +- p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self; +- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp; +- +- if (is_marked(sLAlink_arrayA->s.s_dbind) && COLLECT_RELBLOCK_P +-#ifdef SGC +- && (!sgc_enabled || SGC_RELBLOCK_P(sLAlink_arrayA->s.s_dbind->v.v_self)) +-#endif +- ) { +- fixnum j=rb_pointer1-rb_pointer; +- p=(void *)p+j; +- pe=(void *)pe+j; +- } ++ p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self; ++ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp; + + for (;p=v && *ps.s_dbind==Cnil) ++ if (sSAlink_arrayA->s.s_dbind==Cnil) + return; + +- ne=n=p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self; +- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp; ++ ne=n=p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self; ++ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp; + + while (ps.s_dbind->v.v_fillp=(ne-n)*sizeof(*n); ++ sSAlink_arrayA->s.s_dbind->v.v_fillp=(ne-n)*sizeof(*n); + + } + +@@ -392,11 +423,11 @@ sweep_link_array(void) { + + void ***p,***pe; + +- if (sLAlink_arrayA->s.s_dbind==Cnil) ++ if (sSAlink_arrayA->s.s_dbind==Cnil) + return; + +- p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self; +- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp; ++ p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self; ++ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp; + for (;pst.st_self) && */ ++ /* (dp=PCEI(lcv->st.st_self,r)) && dp+s<=(dpe=lcv->st.st_self+lcv->st.st_dim) */ ++ /* && x && x->d.st>=ngc_thresh) { */ ++ ++ if (what_to_collect!=t_contiguous && ++ x && x->d.st>=ngc_thresh && ++ (dp=alloc_contblock_no_gc(s))) { ++ ++ /* fprintf(stderr,"Promoting %p,%lu to %p\n",p,s,dp); */ ++ /* fflush(stderr); */ ++ ++ *pp=memcpy(dp,p,s); ++ /* lcv->st.st_fillp=lcv->st.st_dim=(dpe-(void *)(lcv->st.st_self=dp+s)); */ ++ x->d.st=0; + +- if (tp==t_cons) { +- mark_cons(x); + return; ++ ++ } ++ ++ if (x && x->d.std.st++; ++ ++ if (p>=(void *)heap_end) ++ *pp=(void *)copy_relblock(p,s); ++ else ++ mark_contblock(p,s); ++ ++} ++ ++static void mark_object1(object); ++#define mark_object(x) if (marking(x)) mark_object1(x) ++ ++static inline void ++mark_object_address(object *o,int f) { ++ ++ static ufixnum lp; ++ static ufixnum lr; ++ ++ ufixnum p=page(o); ++ ++ if (lp!=p || !f) { ++ lp=p; ++ lr=sgc_enabled ? WRITABLE_PAGE_P(lp) : 1; + } + ++ if (lr) ++ mark_object(*o); ++ ++} ++ ++static inline void ++mark_object_array(object *o,object *oe) { ++ int f=0; ++ ++ if (o) ++ for (;oc.c_car); ++ mark_object(Scdr(x));/*FIXME*/ ++ break; + + case t_fixnum: + break; + ++ case t_bignum: ++ MARK_LEAF_DATA(x,MP_SELF(x),MP_ALLOCATED(x)*MP_LIMB_SIZE); ++ break; ++ + case t_ratio: + mark_object(x->rat.rat_num); +- x = x->rat.rat_den; +- goto BEGIN; ++ mark_object(x->rat.rat_den); + + case t_shortfloat: + break; +@@ -456,8 +565,7 @@ mark_object(object x) { + + case t_complex: + mark_object(x->cmp.cmp_imag); +- x = x->cmp.cmp_real; +- goto BEGIN; ++ mark_object(x->cmp.cmp_real); + + case t_character: + break; +@@ -466,13 +574,7 @@ mark_object(object x) { + mark_object(x->s.s_plist); + mark_object(x->s.s_gfdef); + mark_object(x->s.s_dbind); +- if (x->s.s_self == NULL) +- break; +- if (inheap(x->s.s_self)) { +- if (what_to_collect == t_contiguous) +- mark_contblock(x->s.s_self,x->s.s_fillp); +- } else if (COLLECT_RELBLOCK_P) +- x->s.s_self = copy_relblock(x->s.s_self, x->s.s_fillp); ++ MARK_LEAF_DATA(x,x->s.s_self,x->s.s_fillp); + break; + + case t_package: +@@ -481,197 +583,88 @@ mark_object(object x) { + mark_object(x->p.p_shadowings); + mark_object(x->p.p_uselist); + mark_object(x->p.p_usedbylist); +- if (what_to_collect != t_contiguous) +- break; +- if (x->p.p_internal != NULL) +- mark_contblock((char *)(x->p.p_internal), +- x->p.p_internal_size*sizeof(object)); +- if (x->p.p_external != NULL) +- mark_contblock((char *)(x->p.p_external), +- x->p.p_external_size*sizeof(object)); ++ mark_object_array(x->p.p_internal,x->p.p_internal+x->p.p_internal_size); ++ MARK_LEAF_DATA(x,x->p.p_internal,x->p.p_internal_size*sizeof(object)); ++ mark_object_array(x->p.p_external,x->p.p_external+x->p.p_external_size); ++ MARK_LEAF_DATA(x,x->p.p_external,x->p.p_external_size*sizeof(object)); + break; + + case t_hashtable: + mark_object(x->ht.ht_rhsize); + mark_object(x->ht.ht_rhthresh); +- if (x->ht.ht_self == NULL) +- break; +- for (i = 0, j = x->ht.ht_size; i < j; i++) { +- mark_object(x->ht.ht_self[i].hte_key); +- mark_object(x->ht.ht_self[i].hte_value); +- } +- if (inheap(x->ht.ht_self)) { +- if (what_to_collect == t_contiguous) +- mark_contblock((char *)x->ht.ht_self,j*sizeof(struct htent)); +- } else if (COLLECT_RELBLOCK_P) +- x->ht.ht_self=(void *)copy_relblock((char *)x->ht.ht_self,j*sizeof(struct htent));; ++ if (x->ht.ht_self) ++ for (i=0;iht.ht_size;i++) ++ if (x->ht.ht_self[i].hte_key!=OBJNULL) { ++ mark_object_address(&x->ht.ht_self[i].hte_key,i); ++ mark_object_address(&x->ht.ht_self[i].hte_value,i+1); ++ } ++ MARK_LEAF_DATA(x,x->ht.ht_self,x->ht.ht_size*sizeof(*x->ht.ht_self)); + break; + + case t_array: +- if ((x->a.a_displaced) != Cnil) +- mark_displaced_field(x); +- if (x->a.a_dims != NULL) { +- if (inheap(x->a.a_dims)) { +- if (what_to_collect == t_contiguous) +- mark_contblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank); +- } else if (COLLECT_RELBLOCK_P) +- x->a.a_dims = (int *) copy_relblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank); +- } +- if ((enum aelttype)x->a.a_elttype == aet_ch) +- goto CASE_STRING; +- if ((enum aelttype)x->a.a_elttype == aet_bit) +- goto CASE_BITVECTOR; +- if ((enum aelttype)x->a.a_elttype == aet_object) +- goto CASE_GENERAL; +- +- CASE_SPECIAL: +- cp = (char *)(x->fixa.fixa_self); +- if (cp == NULL) +- break; +- /* set j to the size in char of the body of the array */ +- +- switch((enum aelttype)x->a.a_elttype){ +-#define ROUND_RB_POINTERS_DOUBLE \ +-{int tem = ((long)rb_pointer1) & (sizeof(double)-1); \ +- if (tem) \ +- { rb_pointer += (sizeof(double) - tem); \ +- rb_pointer1 += (sizeof(double) - tem); \ +- }} ++ MARK_LEAF_DATA(x,x->a.a_dims,sizeof(int)*x->a.a_rank); ++ ++ case t_vector: ++ case t_bitvector: ++ ++ switch(j ? j : (enum aelttype)x->v.v_elttype) { ++ + case aet_lf: +- j= sizeof(longfloat)*x->lfa.lfa_dim; +- if ((COLLECT_RELBLOCK_P) && !(inheap(cp))) +- ROUND_RB_POINTERS_DOUBLE;/*FIXME gc space violation*/ ++ j= sizeof(longfloat)*x->v.v_dim; ++ if ((COLLECT_RELBLOCK_P) && (void *)x->v.v_self>=(void *)heap_end) ++ rb_pointer=PCEI(rb_pointer,sizeof(double)); /*FIXME GC space violation*/ + break; ++ ++ case aet_bit: ++#define W_SIZE (8*sizeof(fixnum)) ++ j= sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); ++ break; ++ + case aet_char: + case aet_uchar: +- j=sizeof(char)*x->a.a_dim; ++ j=sizeof(char)*x->v.v_dim; + break; ++ + case aet_short: + case aet_ushort: +- j=sizeof(short)*x->a.a_dim; ++ j=sizeof(short)*x->v.v_dim; + break; ++ ++ case aet_object: ++ if (x->v.v_displaced->c.c_car==Cnil) ++ mark_object_array(x->v.v_self,x->v.v_self+x->v.v_dim); ++ + default: +- j=sizeof(fixnum)*x->fixa.fixa_dim;} +- +- goto COPY; +- +- CASE_GENERAL: +- p = x->a.a_self; +- if (p == NULL +-#ifdef HAVE_ALLOCA +- || (char *)p >= core_end +-#endif +- ) +- break; +- j=0; +- if (x->a.a_displaced->c.c_car == Cnil) +- for (i = 0, j = x->a.a_dim; i < j; i++) +- mark_object(p[i]); +- cp = (char *)p; +- j *= sizeof(object); +- COPY: +- if (inheap(cp)) { +- if (what_to_collect == t_contiguous) +- mark_contblock(cp, j); +- } else if (COLLECT_RELBLOCK_P) { +- if (x->a.a_displaced == Cnil) { +-#ifdef HAVE_ALLOCA +- if (!NULL_OR_ON_C_STACK(cp)) /* only if body of array not on C stack */ +-#endif +- x->a.a_self = (object *)copy_relblock(cp, j); +- } else if (x->a.a_displaced->c.c_car == Cnil) { +- i = (long)(object *)copy_relblock(cp, j) - (long)(x->a.a_self); +- adjust_displaced(x, i); +- } ++ j=sizeof(fixnum)*x->v.v_dim; ++ + } +- break; +- +- case t_vector: +- if ((x->v.v_displaced) != Cnil) +- mark_displaced_field(x); +- if ((enum aelttype)x->v.v_elttype == aet_object) +- goto CASE_GENERAL; +- else +- goto CASE_SPECIAL; +- +- case t_bignum: +-#ifndef GMP_USE_MALLOC +- if ((int)what_to_collect >= (int)t_contiguous) { +- j = MP_ALLOCATED(x); +- cp = (char *)MP_SELF(x); +- if (cp == 0) +- break; +-#ifdef PARI +- if (j != lg(MP(x)) && +- /* we don't bother to zero this register, +- and its contents may get over written */ +- ! (x == big_register_1 && +- (int)(cp) <= top && +- (int) cp >= bot)) +- printf("bad length 0x%x ",x); +-#endif +- j = j * MP_LIMB_SIZE; +- if (inheap(cp)) { +- if (what_to_collect == t_contiguous) +- mark_contblock(cp, j); +- } else if (COLLECT_RELBLOCK_P) { +- MP_SELF(x) = (void *) copy_relblock(cp, j);}} +-#endif /* not GMP_USE_MALLOC */ +- break; +- +- CASE_STRING: +- case t_string: +- if ((x->st.st_displaced) != Cnil) +- mark_displaced_field(x); +- j = x->st.st_dim; +- cp = x->st.st_self; +- if (cp == NULL) +- break; +- COPY_STRING: +- if (inheap(cp)) { +- if (what_to_collect == t_contiguous) +- mark_contblock(cp, j); +- } else if (COLLECT_RELBLOCK_P) { +- if (x->st.st_displaced == Cnil) +- x->st.st_self = copy_relblock(cp, j); +- else if (x->st.st_displaced->c.c_car == Cnil) { +- i = copy_relblock(cp, j) - cp; +- adjust_displaced(x, i); ++ ++ case t_string:/*FIXME*/ ++ j=j ? j : x->st.st_dim; ++ ++ if (x->v.v_displaced->c.c_car==Cnil) { ++ void *p=x->v.v_self; ++ MARK_LEAF_DATA(x,x->v.v_self,j); ++ if (x->v.v_displaced!=Cnil) { ++ j=(void *)x->v.v_self-p; ++ x->v.v_self=p; ++ adjust_displaced(x,j); + } +- } ++ } ++ mark_object(x->v.v_displaced); + break; + +- CASE_BITVECTOR: +- case t_bitvector: +- if ((x->bv.bv_displaced) != Cnil) +- mark_displaced_field(x); +- /* We make bitvectors multiple of sizeof(int) in size allocated +- Assume 8 = number of bits in char */ +- +-#define W_SIZE (8*sizeof(fixnum)) +- j= sizeof(fixnum) * +- ((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); +- cp = x->bv.bv_self; +- if (cp == NULL) +- break; +- goto COPY_STRING; +- + case t_structure: +- mark_object(x->str.str_def); +- p = x->str.str_self; +- if (p == NULL) +- break; + { + object def=x->str.str_def; +- unsigned char * s_type = &SLOT_TYPE(def,0); +- unsigned short *s_pos= & SLOT_POS(def,0); +- for (i = 0, j = S_DATA(def)->length; i < j; i++) +- if (s_type[i]==0) mark_object(STREF(object,x,s_pos[i])); +- if (inheap(x->str.str_self)) { +- if (what_to_collect == t_contiguous) +- mark_contblock((char *)p,S_DATA(def)->size); +- } else if (COLLECT_RELBLOCK_P) +- x->str.str_self = (object *)copy_relblock((char *)p, S_DATA(def)->size); ++ unsigned char *s_type= &SLOT_TYPE(def,0); ++ unsigned short *s_pos= &SLOT_POS(def,0); ++ mark_object(x->str.str_def); ++ if (x->str.str_self) ++ for (i=0,j=S_DATA(def)->length;istr.str_self,S_DATA(def)->size); + } + break; + +@@ -684,12 +677,11 @@ mark_object(object x) { + case smm_probe: + mark_object(x->sm.sm_object0); + mark_object(x->sm.sm_object1); +- if (what_to_collect == t_contiguous && +- x->sm.sm_fp && +- x->sm.sm_buffer) +- mark_contblock(x->sm.sm_buffer, BUFSIZ); ++ if (x->sm.sm_fp) { ++ MARK_LEAF_DATA(x,x->sm.sm_buffer,BUFSIZ); ++ } + break; +- ++ + case smm_synonym: + mark_object(x->sm.sm_object0); + break; +@@ -720,44 +712,20 @@ mark_object(object x) { + } + break; + +-#define MARK_CP(a_,b_) {fixnum _t=(b_);if (inheap(a_)) {\ +- if (what_to_collect == t_contiguous) mark_contblock((void *)(a_),_t); \ +- } else if (COLLECT_RELBLOCK_P) (a_)=(void *)copy_relblock((void *)(a_),_t);} +- +-#define MARK_MP(a_) {if ((a_)->_mp_d) \ +- MARK_CP((a_)->_mp_d,(a_)->_mp_alloc*MP_LIMB_SIZE);} +- + case t_random: +- if ((int)what_to_collect >= (int)t_contiguous) { +- MARK_MP(x->rnd.rnd_state._mp_seed); +-#if __GNU_MP_VERSION < 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR < 2) +- if (x->rnd.rnd_state._mp_algdata._mp_lc) { +- MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_a); +- if (!x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m2exp) MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m); +- MARK_CP(x->rnd.rnd_state._mp_algdata._mp_lc,sizeof(*x->rnd.rnd_state._mp_algdata._mp_lc)); +- } +-#endif +- } ++ MARK_LEAF_DATA_ALIGNED(x,x->rnd.rnd_state._mp_seed->_mp_d,x->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE,MP_LIMB_SIZE); + break; + + case t_readtable: +- if (x->rt.rt_self == NULL) +- break; +- if (what_to_collect == t_contiguous) +- mark_contblock((char *)(x->rt.rt_self), +- RTABSIZE*sizeof(struct rtent)); +- for (i = 0; i < RTABSIZE; i++) { +- mark_object(x->rt.rt_self[i].rte_macro); +- if (x->rt.rt_self[i].rte_dtab != NULL) { +- /**/ +- if (what_to_collect == t_contiguous) +- mark_contblock((char *)(x->rt.rt_self[i].rte_dtab), +- RTABSIZE*sizeof(object)); +- for (j = 0; j < RTABSIZE; j++) +- mark_object(x->rt.rt_self[i].rte_dtab[j]); +- /**/ ++ if (x->rt.rt_self) { ++ for (i=0;irt.rt_self[i].rte_macro,i); ++ for (i=0;irt.rt_self[i].rte_dtab,x->rt.rt_self[i].rte_dtab+RTABSIZE); ++ MARK_LEAF_DATA(x,x->rt.rt_self[i].rte_dtab,RTABSIZE*sizeof(object)); + } + } ++ MARK_LEAF_DATA(x,x->rt.rt_self,RTABSIZE*sizeof(struct rtent)); + break; + + case t_pathname: +@@ -770,13 +738,8 @@ mark_object(object x) { + break; + + case t_closure: +- { +- int i ; +- for (i= 0 ; i < x->cl.cl_envdim ; i++) +- mark_object(x->cl.cl_env[i]); +- if (COLLECT_RELBLOCK_P) +- x->cl.cl_env=(void *)copy_relblock((void *)x->cl.cl_env,x->cl.cl_envdim*sizeof(object)); +- } ++ mark_object_array(x->cl.cl_env,x->cl.cl_env+x->cl.cl_envdim); ++ MARK_LEAF_DATA(x,x->cl.cl_env,x->cl.cl_envdim*sizeof(object)); + + case t_cfun: + case t_sfun: +@@ -789,48 +752,40 @@ mark_object(object x) { + + case t_cfdata: + +- if (x->cfd.cfd_self != NULL) +- {int i=x->cfd.cfd_fillp; +- while(i-- > 0) +- mark_object(x->cfd.cfd_self[i]);} +- if (what_to_collect == t_contiguous) { +- mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size); ++ mark_object_array(x->cfd.cfd_self,x->cfd.cfd_self+x->cfd.cfd_fillp); ++ if (what_to_collect == t_contiguous) + mark_link_array(x->cfd.cfd_start,x->cfd.cfd_start+x->cfd.cfd_size); +- } ++ MARK_LEAF_DATA(NULL,x->cfd.cfd_start,x->cfd.cfd_size);/*Code cannot move*/ + break; +- case t_cclosure: ++ ++ case t_cclosure: + mark_object(x->cc.cc_name); + mark_object(x->cc.cc_env); + mark_object(x->cc.cc_data); +- if (x->cc.cc_turbo!=NULL) { +- mark_object(*(x->cc.cc_turbo-1)); +- if (COLLECT_RELBLOCK_P) +- x->cc.cc_turbo=(void *)copy_relblock((char *)(x->cc.cc_turbo-1),(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object))+sizeof(object); ++ if (x->cc.cc_turbo) { ++ x->cc.cc_turbo--; ++ mark_object_array(x->cc.cc_turbo,x->cc.cc_turbo+fix(x->cc.cc_turbo[0])); ++ MARK_LEAF_DATA(x,x->cc.cc_turbo,(1+fix(x->cc.cc_turbo[0]))*sizeof(*x->cc.cc_turbo)); ++ x->cc.cc_turbo++; + } + break; + + case t_spice: + break; +- default: ++ ++ default: + #ifdef DEBUG + if (debug) + printf("\ttype = %d\n", type_of(x)); + #endif + error("mark botch"); ++ + } ++ + } + + static long *c_stack_where; + +-void **contblock_stack_list=NULL; +- +-#define PAGEINFO_P(pi) (pi->magic==PAGE_MAGIC && pi->type<=t_contiguous) +- +-#ifdef SGC +-static void +-sgc_mark_object1(object); +-#endif +- + static void + mark_stack_carefully(void *topv, void *bottomv, int offset) { + +@@ -865,10 +820,9 @@ mark_stack_carefully(void *topv, void *b + + pageoffset=v-(void *)pagetochar(p); + pi=pagetoinfo(p); +- if (!PAGEINFO_P(pi)) continue; ++ if (!pageinfo_p(pi)) continue; + +- for (a=contblock_stack_list;a && a[0]!=pi;a=a[1]); +- if (a) continue; ++ if ((a=contblock_stack_list) && in_contblock_stack_list(pi,&a)) continue; + + tm=tm_of(pi->type); + if (tm->tm_type>=t_end) continue; +@@ -879,13 +833,10 @@ mark_stack_carefully(void *topv, void *b + + if (is_marked_or_free(x)) continue; + +-#ifdef SGC +- if (sgc_enabled) +- sgc_mark_object(x); +- else +-#endif +- mark_object(x); ++ mark_object(x); ++ + } ++ + } + + +@@ -930,10 +881,6 @@ mark_phase(void) { + + for (pp = pack_pointer; pp != NULL; pp = pp->p_link) + mark_object((object)pp); +-#ifdef KCLOVM +- if (ovm_process_created) +- mark_all_stacks(); +-#endif + + #ifdef DEBUG + if (debug) { +@@ -947,18 +894,18 @@ mark_phase(void) { + (int)what_to_collect < (int)t_contiguous) { + */ + +- {int size; ++ /* {int size; */ + +- for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { +- size = pp->p_internal_size; +- if (pp->p_internal != NULL) +- for (i = 0; i < size; i++) +- mark_object(pp->p_internal[i]); +- size = pp->p_external_size; +- if (pp->p_external != NULL) +- for (i = 0; i < size; i++) +- mark_object(pp->p_external[i]); +- }} ++ /* for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { */ ++ /* size = pp->p_internal_size; */ ++ /* if (pp->p_internal != NULL) */ ++ /* for (i = 0; i < size; i++) */ ++ /* mark_object(pp->p_internal[i]); */ ++ /* size = pp->p_external_size; */ ++ /* if (pp->p_external != NULL) */ ++ /* for (i = 0; i < size; i++) */ ++ /* mark_object(pp->p_external[i]); */ ++ /* }} */ + + /* mark the c stack */ + #ifndef N_RECURSION_REQD +@@ -1055,42 +1002,27 @@ mark_c_stack(jmp_buf env1, int n, void ( + #ifndef C_GC_OFFSET + #define C_GC_OFFSET 0 + #endif +- { +- struct pageinfo *v,*tv;void **a; +- fixnum i; +- for (v=contblock_list_head,contblock_stack_list=NULL;v;v=v->next) +- for (i=1;iin_use;i++) { +- tv=pagetoinfo(page(v)+i); +- if (PAGEINFO_P(tv)) { +- a=contblock_stack_list; +- /* printf("%p\n",tv); */ +- contblock_stack_list=alloca(2*sizeof(a)); +- contblock_stack_list[0]=tv; +- contblock_stack_list[1]=a; +- }} +- +- if (&where > cs_org) +- (*fn)(0,cs_org,C_GC_OFFSET); +- else +- (*fn)(cs_org,0,C_GC_OFFSET); ++ if (&where > cs_org) ++ (*fn)(0,cs_org,C_GC_OFFSET); ++ else ++ (*fn)(cs_org,0,C_GC_OFFSET); + +- contblock_stack_list=NULL; +- }} ++ } + + #if defined(__ia64__) +- { +- extern void * __libc_ia64_register_backing_store_base; +- void * bst=GC_save_regs_in_stack(); +- void * bsb=__libc_ia64_register_backing_store_base; +- +- if (bsb>bst) +- (*fn)(bsb,bst,C_GC_OFFSET); +- else +- (*fn)(bst,bsb,C_GC_OFFSET); +- +- } ++ { ++ extern void * __libc_ia64_register_backing_store_base; ++ void * bst=GC_save_regs_in_stack(); ++ void * bsb=__libc_ia64_register_backing_store_base; ++ ++ if (bsb>bst) ++ (*fn)(bsb,bst,C_GC_OFFSET); ++ else ++ (*fn)(bst,bsb,C_GC_OFFSET); ++ ++ } + #endif +- ++ + } + + static void +@@ -1136,12 +1068,10 @@ static void + contblock_sweep_phase(void) { + + STATIC char *s, *e, *p, *q; +- STATIC struct contblock *cbp; + STATIC struct pageinfo *v; ++ ++ reset_contblock_freelist(); + +- cb_pointer = NULL; +- ncb = 0; +- + for (v=contblock_list_head;v;v=v->next) { + bool z; + +@@ -1163,7 +1093,7 @@ contblock_sweep_phase(void) { + #ifdef DEBUG + if (debug) { + for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link) +- printf("%d-byte contblock\n", cbp->cb_size); ++ printf("%lud-byte contblock\n", cbp->cb_size); + fflush(stdout); + } + #endif +@@ -1175,7 +1105,6 @@ contblock_sweep_phase(void) { + + int (*GBC_enter_hook)() = NULL; + int (*GBC_exit_hook)() = NULL; +-char *old_rb_start; + + /* void */ + /* ttss(void) { */ +@@ -1201,10 +1130,6 @@ fixnum fault_pages=0; + void + GBC(enum type t) { + +- long i,j; +-#ifdef SGC +- int in_sgc = sgc_enabled; +-#endif + #ifdef DEBUG + int tm=0; + #endif +@@ -1216,6 +1141,26 @@ GBC(enum type t) { + t=t_contiguous; + } + ++ ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); ++ ++ { /*FIXME try to get this below the setjmp in mark_c_stack*/ ++ struct pageinfo *v,*tv; ++ ufixnum i; ++ void *a; ++ ++ for (v=contblock_list_head,contblock_stack_list=NULL;v;v=v->next) ++ for (i=1;iin_use;i++) { ++ tv=pagetoinfo(page(v)+i); ++ if (pageinfo_p(tv)) { ++ a=contblock_stack_list; ++ /* fprintf(stderr,"pushing %p\n",tv); */ ++ contblock_stack_list=alloca(2*sizeof(a)); ++ contblock_stack_list[0]=tv; ++ contblock_stack_list[1]=a; ++ } ++ } ++ } ++ + if (in_signal_handler && t == t_relocatable) + error("cant gc relocatable in signal handler"); + +@@ -1241,10 +1186,8 @@ GBC(enum type t) { + close_stream(o); + } + +- t = t_relocatable; gc_time = -1; +-#ifdef SGC +- if(sgc_enabled) sgc_quit(); +-#endif ++ /* t = t_relocatable; */ ++ gc_time = -1; + } + + +@@ -1257,10 +1200,15 @@ GBC(enum type t) { + tm_table[(int)t].tm_gbccount++; + tm_table[(int)t].tm_adjgbccnt++; + ++ if (sSAnotify_gbcA->s.s_dbind != Cnil + #ifdef DEBUG +- if (debug || (sSAnotify_gbcA->s.s_dbind != Cnil)) { +- +- if (gc_time < 0) gc_time=0; ++ || debug ++#endif ++ ) { ++ ++ if (gc_time < 0) ++ gc_time=0; ++ + #ifdef SGC + printf("[%s for %ld %s pages..", + (sgc_enabled ? "SGC" : "GC"), +@@ -1272,48 +1220,33 @@ GBC(enum type t) { + (tm_of(t)->tm_npage), + (tm_table[(int)t].tm_name)+1); + #endif ++ + #ifdef SGC + if(sgc_enabled) +- printf("(%ld faulted pages, %ld writable, %ld read only)..",fault_pages,sgc_count_writable(), +- (page(core_end)-first_data_page)-(page(old_rb_start)-page(heap_end))-sgc_count_writable()); ++ printf("(%ld faulted pages, %ld writable, %ld read only)..", ++ fault_pages,(page(core_end)-first_data_page)-(page(rb_start)-page(heap_end))-sgc_count_read_only(), ++ sgc_count_read_only()); + #endif ++ + fflush(stdout); ++ + } +-#endif ++ + if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();} + +- /* maxpage = page(heap_end); */ +- + if (COLLECT_RELBLOCK_P) { + +- i=rb_pointer-REAL_RB_START+PAGESIZE;/*FIXME*/ +- +-#ifdef SGC +- if (sgc_enabled==0) +-#endif +- rb_start = heap_end + PAGESIZE*holepage; ++ char *new_start=heap_end+holepage*PAGESIZE,*new_end=new_start+nrbpage*PAGESIZE; + +- rb_end = heap_end + (holepage + nrbpage) *PAGESIZE; +- +- if (rb_start < rb_pointer) +- rb_start1 = (char *) +- ((long)(rb_pointer + PAGESIZE-1) & -(unsigned long)PAGESIZE); +- else +- rb_start1 = rb_start; +- +- /* as we walk through marking data, we replace the +- relocatable pointers +- in objects by the rb_pointer, advance that +- by the size, and copy the actual +- data there to rb_pointer1, and advance it by the size +- at the end [rb_start1,rb_pointer1] is copied +- to [rb_start,rb_pointer] +- */ +- rb_pointer = rb_start; /* where the new relblock will start */ +- rb_pointer1 = rb_start1;/* where we will copy it to during gc*/ +- +- i = (rb_end < (rb_start1 + i) ? (rb_start1 + i) : rb_end) - heap_end; +- alloc_page(-(i + PAGESIZE - 1)/PAGESIZE); ++ if (new_start!=rb_start) { ++ rb_pointer=new_start; ++ rb_limit=new_end; ++ } else { ++ rb_pointer=(rb_pointertm_sgc == 0) +- {sgc_quit(); +- if (sSAnotify_gbcA->s.s_dbind != Cnil) +- {fprintf(stdout, " (doing full gc)"); +- fflush(stdout);} +- mark_phase();} +- else +- sgc_mark_phase();} ++ sgc_mark_phase(); + else + #endif + mark_phase(); +@@ -1365,27 +1291,16 @@ GBC(enum type t) { + #endif + + if (COLLECT_RELBLOCK_P) { ++ ++ rb_start = heap_end + PAGESIZE*holepage; ++ rb_end = heap_end + (holepage + nrbpage) *PAGESIZE; + +- if (rb_start < rb_start1) { +- j = (rb_pointer-rb_start + PAGESIZE - 1)/PAGESIZE; +- memmove(rb_start,rb_start1,j*PAGESIZE); +- } +- ++ + #ifdef SGC + if (sgc_enabled) + wrimap=(void *)sSAwritableA->s.s_dbind->v.v_self; + #endif + +-#ifdef SGC +- /* we don't know which pages have relblock on them */ +- if(sgc_enabled) { +- fixnum i; +- for (i=page(rb_start);ipromotion_pointer1) { */ ++/* object *p,st; */ ++/* promoting=1; */ ++/* st=alloc_simple_string(""); */ ++/* for (p=promotion_pointer1;pst.st_dim; */ ++ ++/* else switch (x->v.v_elttype) { */ ++ ++/* case aet_lf: */ ++/* j=sizeof(longfloat)*x->v.v_dim; */ ++/* break; */ ++/* case aet_bit: */ ++/* #define W_SIZE (8*sizeof(fixnum)) */ ++/* j=sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); */ ++/* break; */ ++/* case aet_char: */ ++/* case aet_uchar: */ ++/* j=sizeof(char)*x->v.v_dim; */ ++/* break; */ ++/* case aet_short: */ ++/* case aet_ushort: */ ++/* j=sizeof(short)*x->v.v_dim; */ ++/* break; */ ++/* default: */ ++/* j=sizeof(fixnum)*x->v.v_dim; */ ++/* } */ ++ ++/* st->st.st_dim=j; */ ++/* st->st.st_self=alloc_contblock(st->st.st_dim); */ ++/* fprintf(stderr,"Promoting vector leaf bytes %lu at %p, %p -> %p\n",j,x,x->v.v_self,st->st.st_self); */ ++/* fflush(stderr); */ ++/* memcpy(st->st.st_self,x->v.v_self,st->st.st_dim); */ ++/* x->v.v_self=(void *)st->st.st_self; */ ++/* } */ ++/* promoting=0; */ ++/* } */ ++/* } */ ++ ++ + #ifdef DEBUG + if (debug) { + for (i = 0, j = 0; i < (int)t_end; i++) { +@@ -1437,11 +1400,6 @@ GBC(enum type t) { + + interrupt_enable = TRUE; + +-#ifdef SGC +- if (in_sgc && sgc_enabled==0) +- sgc_start(); +-#endif +- + if (GBC_exit_hook != NULL) + (*GBC_exit_hook)(); + +@@ -1468,6 +1426,23 @@ GBC(enum type t) { + + } + ++ /* {static int mv; */ ++ /* if (!mv && COLLECT_RELBLOCK_P) { */ ++ /* mv=1; */ ++ /* if (relb_copied) { */ ++ /* sSAstatic_promotion_areaA->s.s_dbind=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(relb_copied),make_fixnum(aet_char),Ct,make_fixnum(0))); */ ++ /* fprintf(stderr,"Making static promotion area %lu bytes\n",relb_copied); */ ++ /* fflush(stderr); */ ++ /* relb_copied=0; */ ++ /* } else { */ ++ /* fprintf(stderr,"Releasing static promotion area\n"); */ ++ /* fflush(stderr); */ ++ /* sSAstatic_promotion_areaA->s.s_dbind=Cnil; */ ++ /* } */ ++ /* mv=0; */ ++ /* } */ ++ /* } */ ++ + collect_both=0; + + END_NO_INTERRUPT; +@@ -1524,11 +1499,16 @@ FFN(siLroom_report)(void) { + vs_push(make_fixnum(available_pages)); + vs_push(make_fixnum(ncbpage)); + vs_push(make_fixnum(maxcbpage)); +- vs_push(make_fixnum(ncb)); ++ { ++ ufixnum ncb; ++ struct contblock *cbp; ++ for (ncb=0,cbp=cb_pointer;cbp;cbp=cbp->cb_link,ncb++); ++ vs_push(make_fixnum(ncb)); ++ } + vs_push(make_fixnum(cbgbccount)); + vs_push(make_fixnum(holepage)); +- vs_push(make_fixnum(rb_pointer - rb_start)); +- vs_push(make_fixnum(rb_end - rb_pointer)); ++ vs_push(make_fixnum(rb_pointer - (rb_pointer= 0) */ +- /* { *q++ = *p++;} */ +- +- return res; ++ memmove(q,p,s);/*FIXME memcpy*/ ++ ++ return q; ++ + } + + +@@ -1595,18 +1572,124 @@ mark_contblock(void *p, int s) { + q = p + s; + /* SGC cont pages: contblock pages must be no smaller than + sizeof(struct contblock). CM 20030827 */ +- x = (char *)ROUND_DOWN_PTR_CONT(p); +- y = (char *)ROUND_UP_PTR_CONT(q); ++ x = (char *)PFLR(p,CPTR_SIZE); ++ y = (char *)PCEI(q,CPTR_SIZE); + v=get_pageinfo(x); + #ifdef SGC + if (!sgc_enabled || (v->sgc_flags&SGC_PAGE_FLAG)) + #endif +- set_mark_bits(v,x,y); ++ set_mark_bits(v,x,y); ++ } ++ ++DEFUN_NEW("CONTIGUOUS-REPORT",object,fScontiguous_report,SI,1,1,NONE,OO,OO,OO,OO,(void),"") { ++ ++ struct contblock **cbpp; ++ struct pageinfo *v; ++ ufixnum i,j,k,s; ++ struct typemanager *tm=tm_of(t_cfdata); ++ void *p; ++ ++ for (i=j=0,cbpp=&cb_pointer;(*cbpp);) { ++ for (k=0,s=(*cbpp)->cb_size,p=*cbpp;*cbpp && (*cbpp)->cb_size==s;i+=(*cbpp)->cb_size,j++,k++,cbpp=&(*cbpp)->cb_link); ++ fprintf(stderr,"%lu %lu starting at %p\n",k,s,p); ++ } ++ fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j); ++ ++ for (i=j=0,v=contblock_list_head;v;i+=v->in_use,j++,v=v->next) ++ fprintf(stderr,"%lu pages at %p\n",(unsigned long)v->in_use,v); ++ fprintf(stderr,"\nTotal pages %lu in %lu pieces\n\n",i,j); ++ ++ for (i=j=0,v=cell_list_head;v;v=v->next) ++ if (tm->tm_type==v->type) { ++ void *p; ++ ufixnum k; ++ for (p=pagetochar(page(v)),k=0;ktm_nppage;k++,p+=tm->tm_size) { ++ object o=p; ++ if (!is_free(o) && type_of(o)==t_cfdata && (void *)o->cfd.cfd_start>=data_start) { ++ fprintf(stderr,"%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start); ++ i+=o->cfd.cfd_size; ++ j++; ++ } ++ } ++ } ++ fprintf(stderr,"\nTotal code bytes %lu in %lu pieces\n",i,j); ++ ++ for (i=j=0,v=cell_list_head;v;v=v->next) { ++ struct typemanager *tm=tm_of(v->type); ++ void *p; ++ ufixnum k; ++ for (p=pagetochar(page(v)),k=0;ktm_nppage;k++,p+=tm->tm_size) { ++ object o=p; ++ void *d=NULL; ++ ufixnum s=0; ++ if (!is_free(o)) { ++ switch (type_of(o)) { ++ case t_array: ++ case t_vector: ++ d=o->a.a_self; ++ s=o->a.a_dim*sizeof(object); ++ break; ++ case t_hashtable: ++ d=o->ht.ht_self; ++ s=o->ht.ht_size*sizeof(object)*2; ++ break; ++ case t_symbol: ++ d=o->s.s_self; ++ s=o->s.s_fillp; ++ break; ++ case t_string: ++ case t_bitvector: ++ d=o->a.a_self; ++ s=o->a.a_dim; ++ break; ++ case t_package: ++ d=o->p.p_external; ++ s=(o->p.p_external_size+o->p.p_internal_size)*sizeof(object); ++ break; ++ case t_bignum: ++ d=o->big.big_mpz_t._mp_d; ++ s=o->big.big_mpz_t._mp_alloc*MP_LIMB_SIZE; ++ break; ++ case t_structure: ++ d=o->str.str_self; ++ s=S_DATA(o->str.str_def)->length*sizeof(object); ++ break; ++ case t_random: ++ d=o->rnd.rnd_state._mp_seed->_mp_d; ++ s=o->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE; ++ break; ++ case t_cclosure: ++ d=o->cc.cc_turbo; ++ s=fix(o->cc.cc_turbo[-1]); ++ break; ++ case t_cfdata: ++ d=o->cfd.cfd_start; ++ s=o->cfd.cfd_size; ++ break; ++ case t_readtable: ++ d=o->rt.rt_self; ++ s=RTABSIZE*(sizeof(struct rtent));/*FIXME*/ ++ break; ++ default: ++ break; ++ } ++ if (d>=data_start && d<(void *)heap_end && s) { ++ fprintf(stderr,"%lu %s bytes at %p\n",s,tm_table[type_of(o)].tm_name,d); ++ i+=s; ++ j++; ++ } ++ } ++ } ++ } ++ fprintf(stderr,"\nTotal leaf bytes %lu in %lu pieces\n",i,j); ++ ++ return Cnil; ++ + } + +-DEFUN_NEW("GBC",object,fLgbc,LISP,1,1,NONE,OO,OO,OO,OO,(object x0),"") { ++DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE,OO,OO,OO,OO,(object x0),"") { + +- /* 1 args */ ++ /* 1 args */ + + if (x0 == Ct) + GBC(t_other); +@@ -1650,5 +1733,5 @@ gcl_init_GBC(void) { + #ifdef SGC + make_si_function("SGC-ON",siLsgc_on); + #endif +- ++ + } +--- gcl-2.6.12.orig/o/gmp.c ++++ gcl-2.6.12/o/gmp.c +@@ -18,12 +18,12 @@ static void *gcl_gmp_realloc(void *oldme + MP_SELF(big_gcprotect)=0; + bcopy(old,new,oldsize); + /* SGC contblock pages: Its possible this is on an old page CM 20030827 */ +- if (inheap(oldmem)) +-#ifdef SGC +- insert_maybe_sgc_contblock(oldmem,oldsize); +-#else +- insert_contblock(oldmem,oldsize); +-#endif ++/* if (inheap(oldmem)) */ ++/* #ifdef SGC */ ++/* insert_maybe_sgc_contblock(oldmem,oldsize); */ ++/* #else */ ++/* insert_contblock(oldmem,oldsize); */ ++/* #endif */ + + return new; + } +--- gcl-2.6.12.orig/o/hash.d ++++ gcl-2.6.12/o/hash.d +@@ -30,6 +30,7 @@ object sLequal; + object sKsize; + object sKrehash_size; + object sKrehash_threshold; ++object sKstatic; + + #define MHSH(a_) ((a_) & ~(1UL<<(sizeof(a_)*CHAR_SIZE-1))) + +@@ -295,8 +296,9 @@ object hashtable; + hashtable->ht.ht_rhthresh = + make_fixnum(fix(hashtable->ht.ht_rhthresh) + + (new_size - old->ht.ht_size)); +- hashtable->ht.ht_self = +- (struct htent *)alloc_relblock(new_size * sizeof(struct htent)); ++ hashtable->ht.ht_self = hashtable->ht.ht_static ? ++ (struct htent *)alloc_contblock(new_size * sizeof(struct htent)) : ++ (struct htent *)alloc_relblock(new_size * sizeof(struct htent)); + for (i = 0; i < new_size; i++) { + hashtable->ht.ht_self[i].hte_key = OBJNULL; + hashtable->ht.ht_self[i].hte_value = OBJNULL; +@@ -322,6 +324,7 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRES + `sSAdefault_hash_table_rehash_sizeA->s.s_dbind`) + (rehash_threshold + `sSAdefault_hash_table_rehash_thresholdA->s.s_dbind`) ++ (static `Cnil`) + &aux h) + enum httest htt=0; + int i; +@@ -363,9 +366,11 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRES + h->ht.ht_rhsize = rehash_size; + h->ht.ht_rhthresh = rehash_threshold; + h->ht.ht_nent = 0; ++ h->ht.ht_static = static!=Cnil ? 1 : 0; + h->ht.ht_self = NULL; +- h->ht.ht_self = (struct htent *) +- alloc_relblock(fix(size) * sizeof(struct htent)); ++ h->ht.ht_self = h->ht.ht_static ? ++ (struct htent *)alloc_contblock(fix(size) * sizeof(struct htent)) : ++ (struct htent *)alloc_relblock(fix(size) * sizeof(struct htent)); + for(i = 0; i < fix(size); i++) { + h->ht.ht_self[i].hte_key = OBJNULL; + h->ht.ht_self[i].hte_value = OBJNULL; +@@ -547,6 +552,7 @@ gcl_init_hash() + sKtest = make_keyword("TEST"); + sKrehash_size = make_keyword("REHASH-SIZE"); + sKrehash_threshold = make_keyword("REHASH-THRESHOLD"); ++ sKstatic = make_keyword("STATIC"); + + make_function("MAKE-HASH-TABLE", Lmake_hash_table); + make_function("HASH-TABLE-P", Lhash_table_p); +--- gcl-2.6.12.orig/o/let.c ++++ gcl-2.6.12/o/let.c +@@ -226,7 +226,7 @@ is an illegal function definition in FLE + top[0] = MMcons(lex[2], def); + top[0] = MMcons(lex[1], top[0]); + top[0] = MMcons(lex[0], top[0]); +- top[0] = MMcons(sLlambda_block_closure, top[0]); ++ top[0] = MMcons(sSlambda_block_closure, top[0]); + lex_fun_bind(MMcar(def), top[0]); + def_list = MMcdr(def_list); + } +@@ -262,7 +262,7 @@ is an illegal function definition in LAB + top[0] = MMcons(Cnil, top[0]); + top[1] = MMcons(top[0], top[1]); + top[0] = MMcons(lex[0], top[0]); +- top[0] = MMcons(sLlambda_block_closure, top[0]); ++ top[0] = MMcons(sSlambda_block_closure, top[0]); + lex_fun_bind(MMcar(def), top[0]); + def_list = MMcdr(def_list); + } +@@ -315,8 +315,8 @@ gcl_init_let(void) + make_special_form("LET", Flet); + make_special_form("LET*", FletA); + make_special_form("MULTIPLE-VALUE-BIND", Fmultiple_value_bind); +- make_special_form("COMPILER-LET", Fcompiler_let); + make_special_form("FLET",Fflet); + make_special_form("LABELS",Flabels); + make_special_form("MACROLET",Fmacrolet); ++ make_si_special_form("COMPILER-LET", Fcompiler_let); + } +--- gcl-2.6.12.orig/o/lex.c ++++ gcl-2.6.12/o/lex.c +@@ -58,7 +58,7 @@ lex_macro_bind(object name, object exp_f + { + object *top = vs_top; + vs_push(make_cons(exp_fun, Cnil)); +- top[0] = make_cons(sLmacro, top[0]); ++ top[0] = make_cons(sSmacro, top[0]); + top[0] = make_cons(name, top[0]); + lex_env[1]=make_cons(top[0], lex_env[1]); + vs_top = top; +@@ -70,7 +70,7 @@ lex_tag_bind(object tag, object id) + object *top = vs_top; + + vs_push(make_cons(id, Cnil)); +- top[0] = make_cons(sLtag, top[0]); ++ top[0] = make_cons(sStag, top[0]); + top[0] = make_cons(tag, top[0]); + lex_env[2] =make_cons(top[0], lex_env[2]); + vs_top = top; +@@ -95,7 +95,7 @@ lex_tag_sch(object tag) + object alist = lex_env[2]; + + while (!endp(alist)) { +- if (eql(MMcaar(alist), tag) && MMcadar(alist) == sLtag) ++ if (eql(MMcaar(alist), tag) && MMcadar(alist) == sStag) + return(MMcar(alist)); + alist = MMcdr(alist); + } +@@ -120,10 +120,10 @@ gcl_init_lex(void) + { + /* sLfunction = make_ordinary("FUNCTION"); */ + /* enter_mark_origin(&sLfunction); */ +- sLmacro = make_ordinary("MACRO"); +- enter_mark_origin(&sLmacro); +- sLtag = make_ordinary("TAG"); +- enter_mark_origin(&sLtag); ++ sSmacro = make_si_ordinary("MACRO"); ++ enter_mark_origin(&sSmacro); ++ sStag = make_si_ordinary("TAG"); ++ enter_mark_origin(&sStag); + sLblock = make_ordinary("BLOCK"); + enter_mark_origin(&sLblock); + } +--- gcl-2.6.12.orig/o/macros.c ++++ gcl-2.6.12/o/macros.c +@@ -161,7 +161,7 @@ macro_def(object form) + return(head->s.s_gfdef); + else + return(Cnil); +- else if (MMcadr(fd) == sLmacro) ++ else if (MMcadr(fd) == sSmacro) + return(MMcaddr(fd)); + else + return(Cnil); +@@ -279,7 +279,7 @@ macro_expand(object form) + exp_fun = head->s.s_gfdef; + else + return(form); +- else if (MMcadr(fd) == sLmacro) ++ else if (MMcadr(fd) == sSmacro) + exp_fun = MMcaddr(fd); + else + return(form); +@@ -316,7 +316,7 @@ LOOP: + exp_fun = head->s.s_gfdef; + else + goto END; +- else if (MMcadr(fd) == sLmacro) ++ else if (MMcadr(fd) == sSmacro) + exp_fun = MMcaddr(fd); + else + goto END; +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -182,30 +182,41 @@ get_phys_pages_no_malloc(void) { + #else + + ufixnum +-get_phys_pages_no_malloc(void) { +- int l; ++get_proc_meminfo_value_in_pages(const char *k) { ++ int l,m; + char b[PAGESIZE],*c; +- const char *k="MemTotal:",*f="/proc/meminfo"; +- ufixnum res=0,n; ++ ufixnum n; + +- if ((l=open(f,O_RDONLY))!=-1) { +- if ((n=read(l,b,sizeof(b)))>(PAGEWIDTH-10); ++ massert((l=open("/proc/meminfo",O_RDONLY))!=-1); ++ massert((n=read(l,b,sizeof(b)))>(PAGEWIDTH-10); ++} ++ ++ufixnum ++get_phys_pages_no_malloc(char freep) { ++ return freep ? ++ get_proc_meminfo_value_in_pages("MemFree:")+ ++ get_proc_meminfo_value_in_pages("Buffers:")+ ++ get_proc_meminfo_value_in_pages("Cached:") : ++ get_proc_meminfo_value_in_pages("MemTotal:"); + } + + #endif + ++void *initial_sbrk=NULL; ++ + int + update_real_maxpage(void) { + + ufixnum i,j,k; + void *end,*cur,*beg; ++ ufixnum free_phys_pages=get_phys_pages_no_malloc(1),maxpages; + #ifdef __MINGW32__ + static fixnum n; + +@@ -215,6 +226,8 @@ update_real_maxpage(void) { + } + #endif + ++ phys_pages=get_phys_pages_no_malloc(1); ++ + massert(cur=sbrk(0)); + beg=data_start ? data_start : cur; + for (i=0,j=(1L<PAGESIZE;j>>=1) +@@ -225,30 +238,46 @@ update_real_maxpage(void) { + } + massert(!mbrk(cur)); + +- phys_pages=get_phys_pages_no_malloc(); ++/* phys_pages=get_phys_pages_no_malloc(0); */ + +-#ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION +- if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg); +-#endif ++/* #ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION */ ++/* if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg); */ ++/* #endif */ ++ ++ maxpages=real_maxpage-page(beg); + +- available_pages=real_maxpage-page(beg); ++ free_phys_pages=free_phys_pages>maxpages ? maxpages : free_phys_pages; ++ ++ resv_pages=available_pages=0; ++ available_pages=check_avail_pages(); ++ + for (i=t_start,j=0;is.s_dbind!=Cnil) { + +- new_holepage=available_pages/starting_hole_div; +- k=available_pages/20; +- j*=starting_relb_heap_mult; +- j=j>1); ++ } ++ ++ new_holepage=0; ++ for (i=t_start;i= dend) { + minimize_image(); + log_maxpage_bound=l; +@@ -352,6 +369,8 @@ gcl_mprotect(void *v,unsigned long l,int + } + #endif + ++DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_block_reserveA,SI,Cnil,""); ++ + int + main(int argc, char **argv, char **envp) { + +@@ -430,9 +449,10 @@ main(int argc, char **argv, char **envp) + gcl_init_readline_function(); + #endif + #ifdef NEED_STACK_CHK_GUARD +- __stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/ ++ __stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/ + #endif +- ++ allocate_code_block_reserve(); ++ + } + + #ifdef _WIN32 +@@ -549,22 +569,10 @@ initlisp(void) { + import(Ct, lisp_package); + export(Ct, lisp_package); + +-#ifdef ANSI_COMMON_LISP +-/* Cnil->s.s_hpack = common_lisp_package; */ +- import(Cnil, common_lisp_package); +- export(Cnil, common_lisp_package); +- +-/* Ct->s.s_hpack = common_lisp_package; */ +- import(Ct, common_lisp_package); +- export(Ct, common_lisp_package); +-#endif +- +-/* sLquote = make_ordinary("QUOTE"); */ +-/* sLfunction = make_ordinary("FUNCTION"); */ + sLlambda = make_ordinary("LAMBDA"); +- sLlambda_block = make_ordinary("LAMBDA-BLOCK"); +- sLlambda_closure = make_ordinary("LAMBDA-CLOSURE"); +- sLlambda_block_closure = make_ordinary("LAMBDA-BLOCK-CLOSURE"); ++ sSlambda_block = make_si_ordinary("LAMBDA-BLOCK"); ++ sSlambda_closure = make_si_ordinary("LAMBDA-CLOSURE"); ++ sSlambda_block_closure = make_si_ordinary("LAMBDA-BLOCK-CLOSURE"); + sLspecial = make_ordinary("SPECIAL"); + + +@@ -702,7 +710,7 @@ segmentation_catcher(int i) { + /* error("end of file"); */ + /* } */ + +-DEFUNO_NEW("BYE",object,fLbye,LISP ++DEFUNO_NEW("BYE",object,fSbye,SI + ,0,1,NONE,OO,OO,OO,OO,void,Lby,(object exitc),"") + { int n=VFUN_NARGS; + int exit_code; +@@ -714,9 +722,9 @@ DEFUNO_NEW("BYE",object,fLbye,LISP + } + + +-DEFUN_NEW("QUIT",object,fLquit,LISP ++DEFUN_NEW("QUIT",object,fSquit,SI + ,0,1,NONE,OO,OO,OO,OO,(object exitc),"") +-{ return FFN(fLbye)(exitc); } ++{ return FFN(fSbye)(exitc); } + + /* DEFUN_NEW("EXIT",object,fLexit,LISP */ + /* ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"") */ +@@ -976,8 +984,8 @@ FFN(siLsave_system)(void) { + + saving_system = FALSE; + +- Lsave(); +- alloc_page(-(holepage+nrbpage)); ++ siLsave(); ++ alloc_page(-(holepage+2*nrbpage)); + + } + +@@ -990,7 +998,7 @@ DEFVAR("*COMMAND-ARGS*",sSAcommand_argsA + static void + init_main(void) { + +- make_function("BY", Lby); ++ make_si_function("BY", Lby); + make_si_function("ARGC", siLargc); + make_si_function("ARGV", siLargv); + +--- gcl-2.6.12.orig/o/package.d ++++ gcl-2.6.12/o/package.d +@@ -1159,17 +1159,12 @@ gcl_init_package() + { + + lisp_package +- = make_package(make_simple_string("LISP"), +- Cnil, Cnil,47,509); ++ = make_package(make_simple_string("COMMON-LISP"), ++ list(2,make_simple_string("CL"),make_simple_string("LISP")),Cnil,47,509); + user_package +- = make_package(make_simple_string("USER"), +- Cnil, ++ = make_package(make_simple_string("COMMON-LISP-USER"), ++ list(2,make_simple_string("CL-USER"),make_simple_string("USER")), + make_cons(lisp_package, Cnil),509,97); +-#ifdef ANSI_COMMON_LISP +- common_lisp_package +- = make_package(make_simple_string("COMMON-LISP"), +- Cnil, Cnil,47,509); +-#endif + keyword_package + = make_package(make_simple_string("KEYWORD"), + Cnil, Cnil,11,509); +--- gcl-2.6.12.orig/o/predicate.c ++++ gcl-2.6.12/o/predicate.c +@@ -341,9 +341,9 @@ DEFUNO_NEW("FUNCTIONP",object,fLfunction + x0 = Cnil; } + else if (t == t_cons) { + x = x0->c.c_car; +- if (x == sLlambda || x == sLlambda_block || ++ if (x == sLlambda || x == sSlambda_block || + x == sSlambda_block_expanded || +- x == sLlambda_closure || x == sLlambda_block_closure) ++ x == sSlambda_closure || x == sSlambda_block_closure) + x0 = Ct; + else + x0 = Cnil; +@@ -358,6 +358,14 @@ fLfunctionp(object x) { + #endif + + ++DEFUNO_NEW("COMMONP",object,fScommonp,SI,1,1,NONE,OO,OO,OO,OO,void,siLcommonp,(object x0),"") { ++ if (type_of(x0) != t_spice) ++ x0 = Ct; ++ else ++ x0 = Cnil; ++ RETURN1(x0); ++} ++ + DEFUNO_NEW("COMPILED-FUNCTION-P",object,fLcompiled_function_p,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lcompiled_function_p,(object x0),"") + +@@ -377,18 +385,6 @@ DEFUNO_NEW("COMPILED-FUNCTION-P",object, + x0 = Ct; + else + x0 = Cnil; +-RETURN1(x0);} +- +-DEFUNO_NEW("COMMONP",object,fLcommonp,LISP +- ,1,1,NONE,OO,OO,OO,OO,void,Lcommonp,(object x0),"") +- +-{ +- /* 1 args */; +- +- if (type_of(x0) != t_spice) +- x0 = Ct; +- else +- x0 = Cnil; + RETURN1(x0);} + + DEFUN_NEW("EQ",object,fLeq,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -2152,7 +2152,8 @@ LFD(Lreadtablep)() + rdtbl->rt.rt_self[c].rte_chattrib + = cat_terminating; + rdtbl->rt.rt_self[c].rte_macro = fnc; +- @(return Ct) ++ SGC_TOUCH(rdtbl); ++ @(return Ct) + @) + + @(defun get_macro_character (chr &optional (rdtbl `current_readtable()`)) +--- gcl-2.6.12.orig/o/reference.c ++++ gcl-2.6.12/o/reference.c +@@ -82,7 +82,7 @@ LFD(Lsymbol_function)(void) + FEundefined_function(sym); + if (sym->s.s_mflag) { + vs_push(sym->s.s_gfdef); +- vs_base[0] = sLmacro; ++ vs_base[0] = sSmacro; + stack_cons(); + return; + } +@@ -131,7 +131,7 @@ FFN(Ffunction)(object form) + vs_base[0] = MMcons(lex_env[2], vs_base[0]); + vs_base[0] = MMcons(lex_env[1], vs_base[0]); + vs_base[0] = MMcons(lex_env[0], vs_base[0]); +- vs_base[0] = MMcons(sLlambda_closure, vs_base[0]); ++ vs_base[0] = MMcons(sSlambda_closure, vs_base[0]); + } else + FEinvalid_function(fun); + } +@@ -173,7 +173,7 @@ LFD(Lmacro_function)(void) + vs_base[0] = Cnil; + } + +-LFD(Lspecial_form_p)(void) ++LFD(Lspecial_operator_p)(void) + { + check_arg(1); + if (type_of(vs_base[0]) != t_symbol) +@@ -194,7 +194,6 @@ gcl_init_reference(void) + make_function("SYMBOL-VALUE", Lsymbol_value); + make_function("BOUNDP", Lboundp); + make_function("MACRO-FUNCTION", Lmacro_function); +- make_function("SPECIAL-FORM-P", Lspecial_form_p); +- make_function("SPECIAL-OPERATOR-P", Lspecial_form_p); ++ make_function("SPECIAL-OPERATOR-P", Lspecial_operator_p); + } + +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -432,7 +432,7 @@ enum smmode smm; + stream->sm.sm_fp = fp; + stream->sm.sm_buffer = 0; + +- stream->sm.sm_object0 = sLstring_char; ++ stream->sm.sm_object0 = sLcharacter; + stream->sm.sm_object1 = host_l; + stream->sm.sm_int0 = stream->sm.sm_int1 = 0; + vs_push(stream); +--- gcl-2.6.12.orig/o/save.c ++++ gcl-2.6.12/o/save.c +@@ -16,11 +16,12 @@ memory_save(char *original_file, char *s + extern void _cleanup(); + #endif + +-LFD(Lsave)(void) { ++LFD(siLsave)(void) { + + char filename[256]; + extern char *kcl_self; +- ++ extern void *initial_sbrk; ++ + check_arg(1); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); + coerce_to_filename(vs_base[0], filename); +@@ -33,7 +34,8 @@ LFD(Lsave)(void) { + + raw_image=FALSE; + cs_org=0; +- ++ initial_sbrk=core_end; ++ + #ifdef MEMORY_SAVE + MEMORY_SAVE(kcl_self,filename); + #else +--- gcl-2.6.12.orig/o/sfaslbfd.c ++++ gcl-2.6.12/o/sfaslbfd.c +@@ -212,7 +212,7 @@ fasload(object faslfile) { + + set_type_of(&dum,t_stream); + dum.sm.sm_mode=smm_input; +- dum.sm.sm_object0=sLstring_char; ++ dum.sm.sm_object0=sLcharacter; + + link_callbacks.add_archive_element=madd_archive_element; + link_callbacks.multiple_definition=mmultiple_definition; +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -58,7 +58,7 @@ License for more details. + #define LOAD_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info),_t=ELF_ST_TYPE(sym->st_info); \ + sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK || (_t>=STT_LOPROC && _t<=STT_HIPROC));}) + +-#define MASK(n) (~(~0L << (n))) ++#define MASK(n) (~(~0ULL << (n))) + + + +@@ -242,6 +242,46 @@ relocate_symbols(Sym *sym,Sym *syme,Shdr + + } + ++#ifndef MAX_CODE_ADDRESS ++#define MAX_CODE_ADDRESS -1UL ++#endif ++ ++static void * ++alloc_memory(ul sz) { ++ ++ void *v; ++ ++ if (sSAcode_block_reserveA && ++ sSAcode_block_reserveA->s.s_dbind!=Cnil && sSAcode_block_reserveA->s.s_dbind->st.st_dim>=sz) { ++ ++ v=sSAcode_block_reserveA->s.s_dbind->st.st_self; ++ sSAcode_block_reserveA->s.s_dbind->st.st_self+=sz; ++ sSAcode_block_reserveA->s.s_dbind->st.st_dim-=sz; ++ sSAcode_block_reserveA->s.s_dbind->st.st_fillp=sSAcode_block_reserveA->s.s_dbind->st.st_dim; ++ ++ } else ++ v=alloc_contblock(sz); ++ ++ massert(v && (ul)(v+sz)s.s_dbind=alloc_simple_string(n); ++ sSAcode_block_reserveA->s.s_dbind->st.st_self=alloc_memory(n); ++ ++} ++ + static object + load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) { + +@@ -275,9 +315,7 @@ load_memory(Shdr *sec1,Shdr *sece,void * + memory->cfd.cfd_size=sz; + memory->cfd.cfd_self=0; + memory->cfd.cfd_start=0; +- prefer_low_mem_contblock=TRUE; +- memory->cfd.cfd_start=alloc_contblock(sz); +- prefer_low_mem_contblock=FALSE; ++ memory->cfd.cfd_start=alloc_memory(sz); + + a=(ul)memory->cfd.cfd_start; + a=(a+ma)&~ma; +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -7,9 +7,6 @@ + + */ + +-static void +-sgc_mark_object1(object); +- + #ifdef BSD + /* ulong may have been defined in mp.h but the define is no longer needed */ + #undef ulong +@@ -51,81 +48,12 @@ int gclmprotect ( void *addr, size_t len + + #include + +-/* void segmentation_catcher(void); */ +- +- +-#define sgc_mark_pack_list(u) \ +-do {register object xtmp = u; \ +- while (xtmp != Cnil) \ +- {if (ON_WRITABLE_PAGE(xtmp)) {mark(xtmp);} \ +- sgc_mark_object(xtmp->c.c_car); \ +- xtmp=Scdr(xtmp);}}while(0) +- +- + #ifdef SDEBUG + object sdebug; + joe1(){;} + joe() {;} + #endif + +-/* static void */ +-/* sgc_mark_cons(object x) { */ +- +-/* cs_check(x); */ +- +-/* /\* x is already marked. *\/ */ +- +-/* BEGIN: */ +-/* #ifdef SDEBUG */ +-/* if(x==sdebug) joe1(); */ +-/* #endif */ +-/* sgc_mark_object(x->c.c_car); */ +-/* #ifdef OLD */ +-/* IF_WRITABLE(x->c.c_car, goto MARK_CAR;); */ +-/* goto MARK_CDR; */ +- +-/* MARK_CAR: */ +-/* if (!is_marked_or_free(x->c.c_car)) { */ +-/* if (consp(x->c.c_car)) { */ +-/* mark(x->c.c_car); */ +-/* sgc_mark_cons(x->c.c_car); */ +-/* } else */ +-/* sgc_mark_object1(x->c.c_car);} */ +-/* MARK_CDR: */ +-/* #endif */ +-/* /\* if (is_imm_fixnum(x->c.c_cdr)) return; *\/ */ +-/* x = Scdr(x); */ +-/* IF_WRITABLE(x, goto WRITABLE_CDR;); */ +-/* return; */ +-/* WRITABLE_CDR: */ +-/* if (is_marked_or_free(x)) return; */ +-/* if (consp(x)) { */ +-/* mark(x); */ +-/* goto BEGIN; */ +-/* } */ +-/* sgc_mark_object1(x); */ +-/* } */ +- +-inline void +-sgc_mark_cons(object x) { +- +- do { +- object d=x->c.c_cdr; +- mark(x); +- sgc_mark_object(x->c.c_car); +- x=d; +- if (!IS_WRITABLE(page(x)) || is_marked_or_free(x))/*catches Cnil*/ +- return; +- } while (cdr_listp(x)); +- sgc_mark_object(x); +- +-} +- +-/* Whenever two arrays are linked together by displacement, +- if one is live, the other will be made live */ +-#define sgc_mark_displaced_field(ar) sgc_mark_object(ar->a.a_displaced) +- +- + /* structures and arrays of type t, need to be marked if their + bodies are not write protected even if the headers are. + So we should keep these on pages particular to them. +@@ -134,415 +62,6 @@ sgc_mark_cons(object x) { + This takes only 1.47 as opposed to 1.33 microseconds per set. + */ + static void +-sgc_mark_object1(object x) { +- +- fixnum i,j; +- object *p; +- char *cp; +- enum type tp; +- +- cs_check(x); +- BEGIN: +-#ifdef SDEBUG +- if (x == OBJNULL || !ON_WRITABLE_PAGE(x)) +- return; +- IF_WRITABLE(x,goto OK); +- joe(); +- OK: +-#endif +- if (is_marked_or_free(x)) +- return; +-#ifdef SDEBUG +- if(x==sdebug) joe1(); +-#endif +- +- tp=type_of(x); +- +- if (tp==t_cons) { +- sgc_mark_cons(x); +- return; +- } +- +- mark(x); +- +- switch (tp) { +- +- case t_fixnum: +- break; +- +- case t_ratio: +- sgc_mark_object(x->rat.rat_num); +- x = x->rat.rat_den; +- IF_WRITABLE(x,if(!is_marked_or_free(x)) goto BEGIN); +- +- case t_shortfloat: +- break; +- +- case t_longfloat: +- break; +- +- case t_complex: +- sgc_mark_object(x->cmp.cmp_imag); +- x = x->cmp.cmp_real; +- IF_WRITABLE(x,if(!is_marked_or_free(x)) goto BEGIN); +- +- case t_character: +- break; +- +- case t_symbol: +- IF_WRITABLE(x->s.s_plist,if(!is_marked_or_free(x->s.s_plist)) +- {/* mark(x->s.s_plist); */ +- sgc_mark_cons(x->s.s_plist);}); +- sgc_mark_object(x->s.s_gfdef); +- sgc_mark_object(x->s.s_dbind); +- if (x->s.s_self == NULL) +- break; +- /* to do */ +- if (inheap(x->s.s_self)) { +- if (what_to_collect == t_contiguous) +- mark_contblock(x->s.s_self,x->s.s_fillp); +- } else if (SGC_RELBLOCK_P(x->s.s_self) && COLLECT_RELBLOCK_P) +- x->s.s_self = copy_relblock(x->s.s_self, x->s.s_fillp); +- break; +- +- case t_package: +- sgc_mark_object(x->p.p_name); +- sgc_mark_object(x->p.p_nicknames); +- sgc_mark_object(x->p.p_shadowings); +- sgc_mark_object(x->p.p_uselist); +- sgc_mark_object(x->p.p_usedbylist); +- if (what_to_collect == t_contiguous) { +- if (x->p.p_internal != NULL) +- mark_contblock((char *)(x->p.p_internal), +- x->p.p_internal_size*sizeof(object)); +- if (x->p.p_external != NULL) +- mark_contblock((char *)(x->p.p_external), +- x->p.p_external_size*sizeof(object)); +- } +- break; +- +- case t_hashtable: +- sgc_mark_object(x->ht.ht_rhsize); +- sgc_mark_object(x->ht.ht_rhthresh); +- if (x->ht.ht_self == NULL) +- break; +- for (i = 0, j = x->ht.ht_size; i < j; i++) { +- if (ON_WRITABLE_PAGE(&x->ht.ht_self[i])) { +- sgc_mark_object(x->ht.ht_self[i].hte_key); +- sgc_mark_object(x->ht.ht_self[i].hte_value); +- } +- } +- if (inheap(x->ht.ht_self)) { +- if (what_to_collect == t_contiguous) +- mark_contblock((char *)(x->ht.ht_self),j * sizeof(struct htent)); +- } else if (SGC_RELBLOCK_P(x->ht.ht_self) && COLLECT_RELBLOCK_P) +- x->ht.ht_self=(void *)copy_relblock((char *)x->ht.ht_self,j*sizeof(struct htent));; +- break; +- +- case t_array: +- if ((x->a.a_displaced) != Cnil) +- sgc_mark_displaced_field(x); +- if (x->a.a_dims != NULL) { +- if (inheap(x->a.a_dims)) { +- if (what_to_collect == t_contiguous) +- mark_contblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank); +- } else if (SGC_RELBLOCK_P(x->a.a_dims) && COLLECT_RELBLOCK_P) +- x->a.a_dims = (int *) copy_relblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank); +- } +- if ((enum aelttype)x->a.a_elttype == aet_ch) +- goto CASE_STRING; +- if ((enum aelttype)x->a.a_elttype == aet_bit) +- goto CASE_BITVECTOR; +- if ((enum aelttype)x->a.a_elttype == aet_object) +- goto CASE_GENERAL; +- +- CASE_SPECIAL: +- cp = (char *)(x->fixa.fixa_self); +- if (cp == NULL) +- break; +- /* set j to the size in char of the body of the array */ +- +- switch((enum aelttype)x->a.a_elttype){ +- case aet_lf: +- j= sizeof(longfloat)*x->lfa.lfa_dim; +- if ((COLLECT_RELBLOCK_P) && !(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self)) +- ROUND_RB_POINTERS_DOUBLE;/*FIXME gc space violation*/ +- break; +- case aet_char: +- case aet_uchar: +- j=sizeof(char)*x->a.a_dim; +- break; +- case aet_short: +- case aet_ushort: +- j=sizeof(short)*x->a.a_dim; +- break; +- default: +- j=sizeof(fixnum)*x->fixa.fixa_dim;} +- +- goto COPY; +- +- CASE_GENERAL: +- p = x->a.a_self; +- if (p == NULL +-#ifdef HAVE_ALLOCA +- || (char *)p >= core_end +-#endif +- +- ) +- break; +- j=0; +- if (x->a.a_displaced->c.c_car == Cnil) +- for (i = 0, j = x->a.a_dim; i < j; i++) +- if (ON_WRITABLE_PAGE(&p[i])) +- sgc_mark_object(p[i]); +- cp = (char *)p; +- j *= sizeof(object); +- COPY: +- if (inheap(cp)) { +- if (what_to_collect == t_contiguous) +- mark_contblock(cp, j); +- } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) { +- if (x->a.a_displaced == Cnil) { +-#ifdef HAVE_ALLOCA +- if (!NULL_OR_ON_C_STACK(cp)) /* only if body of array not on C stack */ +-#endif +- x->a.a_self = (object *)copy_relblock(cp, j); +- } else if (x->a.a_displaced->c.c_car == Cnil) { +- i = (long)(object *)copy_relblock(cp, j) - (long)(x->a.a_self); +- adjust_displaced(x, i); +- } +- } +- break; +- +- case t_vector: +- if ((x->v.v_displaced) != Cnil) +- sgc_mark_displaced_field(x); +- if ((enum aelttype)x->v.v_elttype == aet_object) +- goto CASE_GENERAL; +- else +- goto CASE_SPECIAL; +- +- case t_bignum: +-#ifdef SDEBUG +- if (TYPE_MAP(page(x->big.big_self)) < t_contiguous) +- printf("bad body for %x (%x)\n",x,cp); +-#endif +-#ifndef GMP_USE_MALLOC +- j = MP_ALLOCATED(x); +- cp = (char *)MP_SELF(x); +- if (cp == 0) +- break; +- j = j * MP_LIMB_SIZE; +- if (inheap(cp)) { +- if (what_to_collect == t_contiguous) +- mark_contblock(cp, j); +- } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) +- MP_SELF(x) = (void *) copy_relblock(cp, j); +-#endif /* not GMP_USE_MALLOC */ +- break; +- +- +- CASE_STRING: +- case t_string: +- if ((x->st.st_displaced) != Cnil) +- sgc_mark_displaced_field(x); +- j = x->st.st_dim; +- cp = x->st.st_self; +- if (cp == NULL) +- break; +- +- COPY_STRING: +- if (inheap(cp)) { +- if (what_to_collect == t_contiguous) +- mark_contblock(cp, j); +- } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) { +- if (x->st.st_displaced == Cnil) +- x->st.st_self = copy_relblock(cp, j); +- else if (x->st.st_displaced->c.c_car == Cnil) { +- i = copy_relblock(cp, j) - cp; +- adjust_displaced(x, i); +- } +- } +- break; +- +- CASE_BITVECTOR: +- case t_bitvector: +- if ((x->bv.bv_displaced) != Cnil) +- sgc_mark_displaced_field(x); +- /* We make bitvectors multiple of sizeof(int) in size allocated +- Assume 8 = number of bits in char */ +- +-#define W_SIZE (8*sizeof(fixnum)) +- j= sizeof(fixnum) * +- ((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); +- cp = x->bv.bv_self; +- if (cp == NULL) +- break; +- goto COPY_STRING; +- +- case t_structure: +- sgc_mark_object(x->str.str_def); +- p = x->str.str_self; +- if (p == NULL) +- break; +- { +- object def=x->str.str_def; +- unsigned char *s_type = &SLOT_TYPE(def,0); +- unsigned short *s_pos = &SLOT_POS (def,0); +- for (i = 0, j = S_DATA(def)->length; i < j; i++) +- if (s_type[i]==0 && ON_WRITABLE_PAGE(&STREF(object,x,s_pos[i]))) +- sgc_mark_object(STREF(object,x,s_pos[i])); +- if (inheap(x->str.str_self)) { +- if (what_to_collect == t_contiguous) +- mark_contblock((char *)p,S_DATA(def)->size); +- } else if (SGC_RELBLOCK_P(p) && (COLLECT_RELBLOCK_P)) +- x->str.str_self = (object *) copy_relblock((char *)p, S_DATA(def)->size); +- } +- break; +- +- case t_stream: +- switch (x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_io: +- case smm_socket: +- case smm_probe: +- sgc_mark_object(x->sm.sm_object0); +- sgc_mark_object(x->sm.sm_object1); +- if (what_to_collect == t_contiguous && +- x->sm.sm_fp && +- x->sm.sm_buffer) +- mark_contblock(x->sm.sm_buffer, BUFSIZ); +- break; +- +- case smm_synonym: +- sgc_mark_object(x->sm.sm_object0); +- break; +- +- case smm_broadcast: +- case smm_concatenated: +- sgc_mark_object(x->sm.sm_object0); +- break; +- +- case smm_two_way: +- case smm_echo: +- sgc_mark_object(x->sm.sm_object0); +- sgc_mark_object(x->sm.sm_object1); +- break; +- +- case smm_string_input: +- case smm_string_output: +- sgc_mark_object(x->sm.sm_object0); +- break; +-#ifdef USER_DEFINED_STREAMS +- case smm_user_defined: +- sgc_mark_object(x->sm.sm_object0); +- sgc_mark_object(x->sm.sm_object1); +- break; +-#endif +- default: +- error("mark stream botch"); +- } +- break; +- +-#define SGC_MARK_CP(a_,b_) {fixnum _t=(b_);if (inheap((a_))) {\ +- if (what_to_collect == t_contiguous) mark_contblock((void *)(a_),_t); \ +- } else if (SGC_RELBLOCK_P((a_)) && COLLECT_RELBLOCK_P) (a_)=(void *)copy_relblock((void *)(a_),_t);} +- +-#define SGC_MARK_MP(a_) {if ((a_)->_mp_d) SGC_MARK_CP((a_)->_mp_d,(a_)->_mp_alloc*MP_LIMB_SIZE);} +- +- case t_random: +- SGC_MARK_MP(x->rnd.rnd_state._mp_seed); +-#if __GNU_MP_VERSION < 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR < 2) +- if (x->rnd.rnd_state._mp_algdata._mp_lc) { +- SGC_MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_a); +- if (!x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m2exp) SGC_MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m); +- SGC_MARK_CP(x->rnd.rnd_state._mp_algdata._mp_lc,sizeof(*x->rnd.rnd_state._mp_algdata._mp_lc)); +- } +-#endif +- break; +- +- case t_readtable: +- if (x->rt.rt_self == NULL) +- break; +- if (what_to_collect == t_contiguous) +- mark_contblock((char *)(x->rt.rt_self),RTABSIZE*sizeof(struct rtent)); +- for (i = 0; i < RTABSIZE; i++) { +- sgc_mark_object(x->rt.rt_self[i].rte_macro); +- if (x->rt.rt_self[i].rte_dtab != NULL) { +- if (what_to_collect == t_contiguous) +- mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),RTABSIZE*sizeof(object)); +- for (j = 0; j < RTABSIZE; j++) +- sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]); +- } +- } +- break; +- +- case t_pathname: +- sgc_mark_object(x->pn.pn_host); +- sgc_mark_object(x->pn.pn_device); +- sgc_mark_object(x->pn.pn_directory); +- sgc_mark_object(x->pn.pn_name); +- sgc_mark_object(x->pn.pn_type); +- sgc_mark_object(x->pn.pn_version); +- break; +- +- case t_closure: +- { +- int i ; +- for (i= 0 ; i < x->cl.cl_envdim ; i++) +- sgc_mark_object(x->cl.cl_env[i]); +- if (SGC_RELBLOCK_P(x->cl.cl_env) && COLLECT_RELBLOCK_P) +- x->cl.cl_env=(void *)copy_relblock((void *)x->cl.cl_env,x->cl.cl_envdim*sizeof(object)); +- +- } +- +- case t_cfun: +- case t_sfun: +- case t_vfun: +- case t_afun: +- case t_gfun: +- sgc_mark_object(x->cf.cf_name); +- sgc_mark_object(x->cf.cf_data); +- break; +- +- case t_cfdata: +- +- if (x->cfd.cfd_self != NULL) { +- int i=x->cfd.cfd_fillp; +- while(i-- > 0) +- sgc_mark_object(x->cfd.cfd_self[i]); +- } +- if (what_to_collect == t_contiguous) { +- mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size); +- mark_link_array(x->cfd.cfd_start,x->cfd.cfd_start+x->cfd.cfd_size); +- } +- break; +- case t_cclosure: +- sgc_mark_object(x->cc.cc_name); +- sgc_mark_object(x->cc.cc_env); +- sgc_mark_object(x->cc.cc_data); +- if (x->cc.cc_turbo!=NULL) { +- sgc_mark_object(*(x->cc.cc_turbo-1)); +- if (SGC_RELBLOCK_P(x->cc.cc_turbo) && COLLECT_RELBLOCK_P) +- x->cc.cc_turbo=(void *)copy_relblock((char *)(x->cc.cc_turbo-1),(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object))+sizeof(object); +- } +- break; +- +- case t_spice: +- break; +- +- default: +-#ifdef DEBUG +- if (debug) +- printf("\ttype = %d\n", type_of(x)); +-#endif +- error("mark botch"); +- } +- +-} +- +-static void + sgc_mark_phase(void) { + + STATIC fixnum i, j; +@@ -552,8 +71,8 @@ sgc_mark_phase(void) { + STATIC ihs_ptr ihsp; + STATIC struct pageinfo *v; + +- sgc_mark_object(Cnil->s.s_plist); +- sgc_mark_object(Ct->s.s_plist); ++ mark_object(Cnil->s.s_plist); ++ mark_object(Ct->s.s_plist); + + /* mark all non recent data on writable pages */ + { +@@ -563,15 +82,17 @@ sgc_mark_phase(void) { + + for (v=cell_list_head;v;v=v->next) { + i=page(v); +- if (!WRITABLE_PAGE_P(i)) continue; ++ if (v->sgc_flags&SGC_PAGE_FLAG || !WRITABLE_PAGE_P(i)) continue; + + t=v->type; + tm=tm_of(t); + p=pagetochar(i); + for (j = tm->tm_nppage; --j >= 0; p += tm->tm_size) { + object x = (object) p; +- if (SGC_OR_M(x)) continue; +- sgc_mark_object1(x); ++#ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(v->type) && x->d.s) continue; ++#endif ++ mark_object1(x); + } + } + } +@@ -595,24 +116,24 @@ sgc_mark_phase(void) { + mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0); + + for (bdp = bds_org; bdp<=bds_top; bdp++) { +- sgc_mark_object(bdp->bds_sym); +- sgc_mark_object(bdp->bds_val); ++ mark_object(bdp->bds_sym); ++ mark_object(bdp->bds_val); + } + + for (frp = frs_org; frp <= frs_top; frp++) +- sgc_mark_object(frp->frs_val); ++ mark_object(frp->frs_val); + + for (ihsp = ihs_org; ihsp <= ihs_top; ihsp++) +- sgc_mark_object(ihsp->ihs_function); ++ mark_object(ihsp->ihs_function); + + for (i = 0; i < mark_origin_max; i++) +- sgc_mark_object(*mark_origin[i]); ++ mark_object(*mark_origin[i]); + for (i = 0; i < mark_origin_block_max; i++) + for (j = 0; j < mark_origin_block[i].mob_size; j++) +- sgc_mark_object(mark_origin_block[i].mob_addr[j]); ++ mark_object(mark_origin_block[i].mob_addr[j]); + + for (pp = pack_pointer; pp != NULL; pp = pp->p_link) +- sgc_mark_object((object)pp); ++ mark_object((object)pp); + #ifdef KCLOVM + if (ovm_process_created) + sgc_mark_all_stacks(); +@@ -624,20 +145,6 @@ sgc_mark_phase(void) { + fflush(stdout); + } + #endif +- { +- int size; +- +- for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { +- size = pp->p_internal_size; +- if (pp->p_internal != NULL) +- for (i = 0; i < size; i++) +- sgc_mark_pack_list(pp->p_internal[i]); +- size = pp->p_external_size; +- if (pp->p_external != NULL) +- for (i = 0; i < size; i++) +- sgc_mark_pack_list(pp->p_external[i]); +- } +- } + + mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully); + +@@ -657,9 +164,6 @@ sgc_sweep_phase(void) { + + tm = tm_of((enum type)v->type); + +- if (!WRITABLE_PAGE_P(page(v))) +- continue; +- + p = pagetochar(page(v)); + f = tm->tm_free; + k = 0; +@@ -678,14 +182,18 @@ sgc_sweep_phase(void) { + continue; + } + +- if (TYPEWORD_TYPE_P(pageinfo(x)->type) && x->d.s == SGC_NORMAL) ++#ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(v->type) && x->d.s == SGC_NORMAL) + continue; ++#endif + + /* it is ok to free x */ + + SET_LINK(x,f); + make_free(x); ++#ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT; ++#endif + f = x; + k++; + +@@ -694,7 +202,7 @@ sgc_sweep_phase(void) { + tm->tm_nfree += k; + v->in_use-=k; + +- } else /*non sgc_page */ ++ } else if (WRITABLE_PAGE_P(page(v))) /*non sgc_page */ + for (j = tm->tm_nppage; --j >= 0; p += size) { + x = (object)p; + if (is_marked(x) && !is_free(x)) { +@@ -711,9 +219,9 @@ sgc_contblock_sweep_phase(void) { + + STATIC char *s, *e, *p, *q; + STATIC struct pageinfo *v; ++ ++ reset_contblock_freelist(); + +- cb_pointer = NULL; +- ncb = 0; + for (v=contblock_list_head;v;v=v->next) { + bool z; + +@@ -739,13 +247,6 @@ sgc_contblock_sweep_phase(void) { + + } + +- +- +-#define PAGE_ROUND_UP(adr) \ +- ((char *)(PAGESIZE*(((long)(adr)+PAGESIZE -1) >> PAGEWIDTH))) +- +-/* char *old_rb_start; */ +- + #undef tm + + #ifdef SDEBUG +@@ -763,11 +264,11 @@ sgc_count(object yy) { + + fixnum writable_pages=0; + +-/* count writable pages excluding the hole */ ++/* count read-only pages */ + static fixnum +-sgc_count_writable(void) { ++sgc_count_read_only(void) { + +- return page(core_end)-page(rb_start)+writable_pages-(page(old_rb_start)-page(heap_end)); ++ return sgc_enabled ? sSAwritableA->s.s_dbind->v.v_dim-writable_pages : 0; + + } + +@@ -1031,7 +532,11 @@ memprotect_test_reset(void) { + /* If opt_maxpage is set, add full pages to the sgc set if needed + too. 20040804 CM*/ + /* #define FSGC(tm) (tm->tm_type==t_cons ? tm->tm_nppage : (tm->tm_opt_maxpage ? 0 : tm->tm_sgc_minfree)) */ ++#ifdef SGC_WHOLE_PAGE ++#define FSGC(tm) tm->tm_nppage ++#else + #define FSGC(tm) (!TYPEWORD_TYPE_P(tm->tm_type) ? tm->tm_nppage : tm->tm_sgc_minfree) ++#endif + + DEFVAR("*WRITABLE*",sSAwritableA,SI,Cnil,""); + +@@ -1047,13 +552,16 @@ sgc_start(void) { + object omp=sSAoptimize_maximum_pagesA->s.s_dbind; + double tmp,scale; + ++ allocate_more_pages=0; ++ if (sgc_enabled) ++ return 1; ++ + sSAoptimize_maximum_pagesA->s.s_dbind=Cnil; + + if (memprotect_result!=memprotect_success && do_memprotect_test()) + return 0; + +- if (sgc_enabled) +- return 1; ++ empty_relblock(); + + /* Reset maxpage statistics if not invoked automatically on a hole + overrun. 20040804 CM*/ +@@ -1193,26 +701,7 @@ sgc_start(void) { + + } + +- /* Now allocate the sgc relblock. We do this as the tail +- end of the ordinary rb. */ +- { +- char *new; +- tm=tm_of(t_relocatable); +- +- { +- old_rb_start=rb_start; +- if(((unsigned long)WSGC(tm)) && allocate_more_pages) { +- new=alloc_relblock(((unsigned long)WSGC(tm))*PAGESIZE); +- /* the above may cause a gc, shifting the relblock */ +- old_rb_start=rb_start; +- new= PAGE_ROUND_UP(new); +- } else new=PAGE_ROUND_UP(rb_pointer); +- rb_start=rb_pointer=new; +- } +- } +- /* the relblock has been allocated */ +- +- sSAwritableA->s.s_dbind=fSmake_vector1_1((page(rb_start)-first_data_page),aet_bit,Cnil); ++ sSAwritableA->s.s_dbind=fSmake_vector1_1((page(heap_end)-first_data_page),aet_bit,Ct); + wrimap=(void *)sSAwritableA->s.s_dbind->v.v_self; + + /* now move the sgc free lists into place. alt_free should +@@ -1231,12 +720,16 @@ sgc_start(void) { + #endif + if (pageinfo(f)->sgc_flags&SGC_PAGE_FLAG) { + SET_LINK(f,x); ++#ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_RECENT; ++#endif + x=f; + count++; + } else { + SET_LINK(f,y); ++#ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_NORMAL; ++#endif + y=f; + } + f=next; +@@ -1253,9 +746,12 @@ sgc_start(void) { + + { + +- struct contblock *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp; ++ struct contblock **cbpp; + void *p=NULL,*pe; + struct pageinfo *pi; ++ ++ old_cb_pointer=cb_pointer; ++ reset_contblock_freelist(); + + for (pi=contblock_list_head;pi;pi=pi->next) { + +@@ -1264,26 +760,17 @@ sgc_start(void) { + p=CB_DATA_START(pi); + pe=p+CB_DATA_SIZE(pi->in_use); + +- for (cbpp=&cb_pointer;*cbpp;) ++ for (cbpp=&old_cb_pointer;*cbpp;) + if ((void *)*cbpp>=p && (void *)*cbppcb_size,*l=(*cbpp)->cb_link; + set_sgc_bits(pi,s,e); +- tmp_cb_pointer=cb_pointer; +- cb_pointer=new_cb_pointer; + insert_contblock(s,e-s); +- new_cb_pointer=cb_pointer; +- cb_pointer=tmp_cb_pointer; + *cbpp=l; + } else + cbpp=&(*cbpp)->cb_link; + + } + +- /* SGC contblock pages: switch to new free SGC contblock list. CM +- 20030827 */ +- old_cb_pointer=cb_pointer; +- cb_pointer=new_cb_pointer; +- + #ifdef SGC_CONT_DEBUG + overlap_check(old_cb_pointer,cb_pointer); + #endif +@@ -1315,11 +802,13 @@ sgc_start(void) { + SET_WRITABLE(i); + } + +- for (i=page(heap_end);itm_alt_npage=page(rb_start)-page(old_rb_start); +- for (i=page(rb_start);is.s_dbind; ++ for (i=page(v->v.v_self);i<=page(v->v.v_self+CEI(v->bv.bv_offset+v->v.v_dim-1,8*sizeof(fixnum))/(8*sizeof(fixnum)));i++) + SET_WRITABLE(i); ++ } ++ ++ tm_of(t_relocatable)->tm_alt_npage=0; + + fault_pages=0; + +@@ -1363,8 +852,7 @@ sgc_quit(void) { + + struct typemanager *tm; + struct contblock *tmp_cb_pointer,*next; +- unsigned long i,j,np; +- char *p; ++ unsigned long i,np; + struct pageinfo *v; + + memory_protect(0); +@@ -1379,7 +867,6 @@ sgc_quit(void) { + wrimap=NULL; + + sgc_enabled=0; +- rb_start = old_rb_start; + + /* SGC cont pages: restore contblocks, each tmp_cb_pointer coming + from the new list is guaranteed not to be on the old. Need to +@@ -1389,9 +876,7 @@ sgc_quit(void) { + #ifdef SGC_CONT_DEBUG + overlap_check(old_cb_pointer,cb_pointer); + #endif +- tmp_cb_pointer=cb_pointer; +- cb_pointer=old_cb_pointer; +- for (;tmp_cb_pointer; tmp_cb_pointer=next) { ++ for (tmp_cb_pointer=old_cb_pointer;tmp_cb_pointer; tmp_cb_pointer=next) { + next=tmp_cb_pointer->cb_link; + insert_contblock((void *)tmp_cb_pointer,tmp_cb_pointer->cb_size); + } +@@ -1440,11 +925,13 @@ sgc_quit(void) { + + /*FIXME*/ + /* remove the recent flag from any objects on sgc pages */ +- for (v=cell_list_head;v;v=v->next) ++#ifndef SGC_WHOLE_PAGE ++ for (v=cell_list_head;v;v=v->next) + if (v->type==(tm=tm_of(v->type))->tm_type && TYPEWORD_TYPE_P(v->type) && v->sgc_flags & SGC_PAGE_FLAG) + for (p=pagetochar(page(v)),j=tm->tm_nppage;j>0;--j,p+=tm->tm_size) +- ((object) p)->d.s=SGC_NORMAL; +- ++ ((object) p)->d.s=SGC_NORMAL; ++#endif ++ + for (v=contblock_list_head;v;v=v->next) + if (v->sgc_flags&SGC_PAGE_FLAG) + bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v)); +@@ -1488,7 +975,6 @@ memprotect_handler(int sig, long code, v + faddr = addr; + #endif + p = page(faddr); +- /* p = ROUND_DOWN_PAGE_NO(p); */ + if (p >= first_protectable_page + && faddr < (void *)core_end + && !(WRITABLE_PAGE_P(p))) { +@@ -1560,10 +1046,10 @@ memory_protect(int on) { + INSTALL_MPROTECT_HANDLER; + + beg=first_protectable_page; +- writable = IS_WRITABLE(beg); ++ writable = WRITABLE_PAGE_P(beg); + for (i=beg ; ++i<= end; ) { + +- if (writable==IS_WRITABLE(i) && i<=end) continue; ++ if (writable==WRITABLE_PAGE_P(i) && ist.st_self = alloc_relblock(fix(size)); +--- gcl-2.6.12.orig/o/structure.c ++++ gcl-2.6.12/o/structure.c +@@ -257,7 +257,7 @@ LFD(siLmake_structure)(void) + } + + static void +-FFN(siLcopy_structure)(void) ++FFN(Lcopy_structure)(void) + { + object x, y; + struct s_data *def; +@@ -452,7 +452,7 @@ gcl_init_structure_function(void) + + make_si_function("MAKE-STRUCTURE", siLmake_structure); + make_si_function("MAKE-S-DATA-STRUCTURE",siLmake_s_data_structure); +- make_si_function("COPY-STRUCTURE", siLcopy_structure); ++ make_function("COPY-STRUCTURE", Lcopy_structure); + make_si_function("STRUCTURE-NAME", siLstructure_name); + /* make_si_function("STRUCTURE-REF", siLstructure_ref); */ + /* make_si_function("STRUCTURE-DEF", siLstructure_def); */ +--- gcl-2.6.12.orig/o/toplevel.c ++++ gcl-2.6.12/o/toplevel.c +@@ -68,12 +68,12 @@ FFN(Fdefun)(object args) + } + vs_base = vs_top; + if (lex_env[0] == Cnil && lex_env[1] == Cnil && lex_env[2] == Cnil) { +- vs_push(MMcons(sLlambda_block, args)); ++ vs_push(MMcons(sSlambda_block, args)); + } else { + vs_push(MMcons(lex_env[2], args)); + vs_base[0] = MMcons(lex_env[1], vs_base[0]); + vs_base[0] = MMcons(lex_env[0], vs_base[0]); +- vs_base[0] = MMcons(sLlambda_block_closure, vs_base[0]); ++ vs_base[0] = MMcons(sSlambda_block_closure, vs_base[0]); + } + {object fname = clear_compiler_properties(name,vs_base[0]); + fname->s.s_gfdef = vs_base[0]; +--- gcl-2.6.12.orig/o/typespec.c ++++ gcl-2.6.12/o/typespec.c +@@ -73,7 +73,7 @@ LFD(Ltype_of)(void) + if ((' ' <= i && i < '\177') || i == '\n') + vs_base[0] = sLstandard_char; + else +- vs_base[0] = sLstring_char; ++ vs_base[0] = sLcharacter; + } + break; + +@@ -176,7 +176,6 @@ LFD(Ltype_of)(void) + DEF_ORDINARY("PROCLAIMED-ARG-TYPES",sSproclaimed_arg_types,SI,""); + DEF_ORDINARY("PROCLAIMED-RETURN-TYPE",sSproclaimed_return_type,SI,""); + DEF_ORDINARY("PROCLAIMED-FUNCTION",sSproclaimed_function,SI,""); +-DEF_ORDINARY("COMMON",sLcommon,LISP,""); + DEF_ORDINARY("NULL",sLnull,LISP,""); + DEF_ORDINARY("CONS",sLcons,LISP,""); + DEF_ORDINARY("LIST",sLlist,LISP,""); +@@ -197,7 +196,6 @@ DEF_ORDINARY("CHARACTER",sLcharacter,LIS + DEF_ORDINARY("NUMBER",sLnumber,LISP,""); + DEF_ORDINARY("RATIONAL",sLrational,LISP,""); + DEF_ORDINARY("FLOAT",sLfloat,LISP,""); +-DEF_ORDINARY("STRING-CHAR",sLstring_char,LISP,""); + DEF_ORDINARY("REAL",sLreal,LISP,""); + DEF_ORDINARY("INTEGER",sLinteger,LISP,""); + DEF_ORDINARY("RATIO",sLratio,LISP,""); +@@ -205,7 +203,6 @@ DEF_ORDINARY("SHORT-FLOAT",sLshort_float + DEF_ORDINARY("STANDARD-CHAR",sLstandard_char,LISP,""); + DEF_ORDINARY("BOOLEAN",sLboolean,LISP,""); + DEF_ORDINARY("FIXNUM",sLfixnum,LISP,""); +-DEF_ORDINARY("POSITIVE-FIXNUM",sLpositive_fixnum,LISP,""); + DEF_ORDINARY("COMPLEX",sLcomplex,LISP,""); + DEF_ORDINARY("SINGLE-FLOAT",sLsingle_float,LISP,""); + DEF_ORDINARY("PACKAGE",sLpackage,LISP,""); +@@ -228,10 +225,10 @@ DEF_ORDINARY("VALUES",sLvalues,LISP,""); + DEF_ORDINARY("MOD",sLmod,LISP,""); + DEF_ORDINARY("SIGNED-BYTE",sLsigned_byte,LISP,""); + DEF_ORDINARY("UNSIGNED-BYTE",sLunsigned_byte,LISP,""); +-DEF_ORDINARY("SIGNED-CHAR",sLsigned_char,LISP,""); +-DEF_ORDINARY("UNSIGNED-CHAR",sLunsigned_char,LISP,""); +-DEF_ORDINARY("SIGNED-SHORT",sLsigned_short,LISP,""); +-DEF_ORDINARY("UNSIGNED-SHORT",sLunsigned_short,LISP,""); ++DEF_ORDINARY("SIGNED-CHAR",sSsigned_char,SI,""); ++DEF_ORDINARY("UNSIGNED-CHAR",sSunsigned_char,SI,""); ++DEF_ORDINARY("SIGNED-SHORT",sSsigned_short,SI,""); ++DEF_ORDINARY("UNSIGNED-SHORT",sSunsigned_short,SI,""); + DEF_ORDINARY("*",sLA,LISP,""); + DEF_ORDINARY("PLUSP",sLplusp,LISP,""); + DEF_ORDINARY("DIVISION-BY-ZERO",sLdivision_by_zero,LISP,""); +@@ -244,8 +241,6 @@ DEF_ORDINARY("UNDEFINED-FUNCTION",sLunde + DEF_ORDINARY("UNBOUND-VARIABLE",sLunbound_variable,LISP,""); + DEF_ORDINARY("PACKAGE-ERROR",sLpackage_error,LISP,""); + +-/* #ifdef ANSI_COMMON_LISP */ +-/* New ansi types */ + DEF_ORDINARY("METHOD-COMBINATION",sLmethod_combination,LISP,""); + DEF_ORDINARY("ARITHMETIC-ERROR",sLarithmetic_error,LISP,""); + DEF_ORDINARY("BASE-CHAR",sLbase_char,LISP,""); +@@ -290,7 +285,6 @@ DEF_ORDINARY("TWO-WAY-STREAM",sLtwo_way_ + DEF_ORDINARY("TYPE-ERROR",sLtype_error,LISP,""); + DEF_ORDINARY("UNBOUND-SLOT",sLunbound_slot,LISP,""); + DEF_ORDINARY("WARNING",sLwarning,LISP,""); +-/* #endif */ + + DEFCONST("CHAR-SIZE",sSchar_size,SI,small_fixnum(CHAR_SIZE),"Size in bits of a character"); + DEFCONST("SHORT-SIZE",sSshort_size,SI,small_fixnum(CHAR_SIZE*sizeof(short)),"Size in bits of a short integer"); +--- gcl-2.6.12.orig/o/unexelf.c ++++ gcl-2.6.12/o/unexelf.c +@@ -634,7 +634,7 @@ find_section (char *name, char *section_ + static void + unexec (char *new_name, char *old_name, unsigned int data_start, unsigned int bss_start, unsigned int entry_address) + { +- int new_file, old_file, new_file_size; ++ int new_file, old_file; + + /* Pointers to the base of the image of the two files. */ + caddr_t old_base, new_base; +@@ -654,17 +654,14 @@ unexec (char *new_name, char *old_name, + /* Point to the section name table in the old file */ + char *old_section_names; + +- ElfW(Addr) old_bss_addr, new_bss_addr; +- ElfW(Word) old_bss_size, new_data2_size,old_bss_offset; +- ElfW(Off) new_data2_offset; +- ElfW(Addr) new_data2_addr; ++ ElfW(Addr) old_bss_addr, new_bss_addr,new_data2_addr; ++ ElfW(Off) old_bss_size, new_data2_size,old_bss_offset,new_data2_offset,old_file_size,new_file_size; + + int n, nn; + int old_bss_index, old_sbss_index; + int old_data_index, new_data2_index; + int old_mdebug_index; + struct stat stat_buf; +- int old_file_size; + + /* Open the old file, allocate a buffer of the right size, and read + in the file contents. */ +--- gcl-2.6.12.orig/o/unixsave.c ++++ gcl-2.6.12/o/unixsave.c +@@ -140,7 +140,7 @@ char *original_file, *save_file; + + extern void _cleanup(); + +-LFD(Lsave)() { ++LFD(siLsave)() { + char filename[256]; + + check_arg(1); +@@ -159,6 +159,6 @@ LFD(Lsave)() { + void + gcl_init_unixsave(void) + { +- make_function("SAVE", Lsave); ++ make_si_function("SAVE", siLsave); + } + +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -169,7 +169,7 @@ msystem(const char *s) { + } + + static void +-FFN(Lsystem)(void) ++FFN(siLsystem)(void) + { + char command[32768]; + int i; +@@ -284,6 +284,6 @@ un_mmap(void *v1,void *ve) { + void + gcl_init_unixsys(void) { + +- make_function("SYSTEM", Lsystem); ++ make_si_function("SYSTEM", siLsystem); + + } +--- gcl-2.6.12.orig/o/unixtime.c ++++ gcl-2.6.12/o/unixtime.c +@@ -282,7 +282,7 @@ DEFUN_NEW("CURRENT-TIMEZONE",object,fScu + localtime_r(&_t, <); + return (object)(gt.tm_hour-lt.tm_hour+24*(gt.tm_yday!=lt.tm_yday ? (gt.tm_year>lt.tm_year||gt.tm_yday>lt.tm_yday ? 1 : -1) : 0)); + #else +- fixnum _t=time(0); ++ time_t _t=time(0); + return (object)(-localtime(&_t)->tm_gmtoff/3600); + #endif + } +@@ -296,7 +296,7 @@ DEFUN_NEW("CURRENT-DSTP",object,fScurren + #elif defined NO_SYSTEM_TIME_ZONE /*solaris*/ + return Cnil; + #else +- fixnum _t=time(0); ++ time_t _t=time(0); + return localtime(&_t)->tm_isdst > 0 ? Ct : Cnil; + #endif + } +--- gcl-2.6.12.orig/pcl/defsys.lisp ++++ gcl-2.6.12/pcl/defsys.lisp +@@ -52,24 +52,10 @@ + + (in-package :user) + +-#+kcl (in-package :walker :use '(:lisp)) +-#+kcl (in-package :iterate :use '(:lisp :walker)) +-#+kcl (in-package :pcl :use '(:walker :iterate :lisp)) ++(load "package.lisp") + + (eval-when (compile load eval) + +-(if (find-package ':walker) +- (use-package '(:lisp) ':walker) +- (make-package ':walker :use '(:lisp))) +- +-(if (find-package ':iterate) +- (use-package '(:lisp :walker) ':iterate) +- (make-package ':iterate :use '(:lisp :walker))) +- +-(if (find-package ':pcl) +- (use-package '(:walker :iterate :lisp) ':pcl) +- (make-package ':pcl :use '(:walker :iterate :lisp))) +- + (export (intern (symbol-name :iterate) ;Have to do this here, + (find-package :iterate)) ;because in the defsystem + (find-package :iterate)) ;(later in this file) +@@ -90,7 +76,7 @@ + + (eval-when (compile load eval) + (defvar *pcl-proclaim* +- '(optimize (speed 3) (safety #+kcl 0 #-kcl 1) (space 0) ++ '(optimize (speed 3) (safety 1) (space 0) + #+lucid (compilation-speed 0))) + ) + +@@ -261,7 +247,6 @@ and load your system with: + #+Xerox-Medley (Xerox-Medley xerox) + #+TI TI + #+(and dec vax common) Vaxlisp +- #+KCL KCL + #+IBCL IBCL + #+gcl gcl + #+excl (excl franz) +@@ -305,7 +290,6 @@ and load your system with: + #+Cloe-Runtime ("l" . "fasl") + #+(and dec common vax (not ultrix)) ("LSP" . "FAS") + #+(and dec common vax ultrix) ("lsp" . "fas") +- #+KCL ("lsp" . "o") + #+IBCL ("lsp" . "o") + #+Xerox ("lisp" . "dfasl") + #+(and Lucid MC68000) ("lisp" . "lbin") +@@ -675,7 +659,7 @@ and load your system with: + ;; 3.0 it's in the LUCID-COMMON-LISP package. + ;; + #+LUCID (or lucid::*source-pathname* (bad-time)) +- #+akcl si:*load-pathname* ++ #+akcl *load-pathname* + #+cmu17 *load-truename* + #-(or Lispm excl Xerox (and dec vax common) LUCID akcl cmu17) nil)) + +--- gcl-2.6.12.orig/pcl/gcl_pcl_pkg.lisp ++++ gcl-2.6.12/pcl/gcl_pcl_pkg.lisp +@@ -176,11 +176,8 @@ + + nil)) + +-#+kcl +-(progn +-(import '(si:structurep si:structure-def si:structure-ref)) +-(shadow 'lisp:dotimes) +-) ++#+kcl(import '(si:structurep si:structure-def si:structure-ref)) ++ + #+kcl + (in-package "SI") + #+kcl +--- gcl-2.6.12.orig/pcl/gcl_pcl_walk.lisp ++++ gcl-2.6.12/pcl/gcl_pcl_walk.lisp +@@ -608,7 +608,7 @@ + (push `(,(car f) . (function . (,#'unbound-lexical-function . nil))) + lexicals)) + (dolist (m macros) +- (push `(,(car m) . (macro . ( ,(cadr m) . nil))) ++ (push `(,(car m) . (si::macro . ( ,(cadr m) . nil))) + lexicals)) + (list first lexicals third))) + +@@ -623,7 +623,7 @@ + (when env + (let ((entry (assoc macro (second env)))) + (and entry +- (eq (cadr entry) 'macro) ++ (eq (cadr entry) 'si::macro) + (caddr entry))))) + );#+(or KCL IBCL) + +@@ -1202,7 +1202,7 @@ + + #+(or KCL IBCL) + (progn +- (define-walker-template lambda-block walk-named-lambda);Not really right, ++ (define-walker-template si::lambda-block walk-named-lambda);Not really right, + ;we don't hack block + ;names anyways. + ) +@@ -1367,7 +1367,7 @@ + #+cmu17 + (special-operator-p fn) + #-cmu17 +- (special-form-p fn)) ++ (special-operator-p fn)) + (error + "~S is a special form, not defined in the CommonLisp.~%~ + manual This code walker doesn't know how to walk it.~%~ +--- gcl-2.6.12.orig/pcl/impl/gcl/gcl_pcl_impl_low.lisp ++++ gcl-2.6.12/pcl/impl/gcl/gcl_pcl_impl_low.lisp +@@ -277,17 +277,17 @@ static object set_cclosure (object resul + (fourth slotd)) + + (defun renew-sys-files() +- ;; packages: +- (compiler::get-packages "sys-package.lisp") +- (with-open-file (st "sys-package.lisp" +- :direction :output +- :if-exists :append) +- (format st "(lisp::in-package \"SI\") +-(export '(%structure-name +- %compiled-function-name +- %set-compiled-function-name)) +-(in-package \"PCL\") +-")) ++;; ;; packages: ++;; (compiler::get-packages "sys-package.lisp") ++;; (with-open-file (st "sys-package.lisp" ++;; :direction :output ++;; :if-exists :append) ++;; (format st "(lisp::in-package \"SI\") ++;; (export '(%structure-name ++;; %compiled-function-name ++;; %set-compiled-function-name)) ++;; (in-package \"PCL\") ++;; ")) + + ;; proclaims + (compiler::make-all-proclaims "*.fn") +--- gcl-2.6.12.orig/pcl/makefile ++++ gcl-2.6.12/pcl/makefile +@@ -9,9 +9,7 @@ GFILES:=$(addprefix gcl_pcl_gazonk,$(GFI + + AFILES:=$(FILES) $(GFILES) + +-SETUP='(load "sys-package.lisp")' \ +- '(setq *features* (delete (quote :kcl) *features*))'\ +- '(load "defsys.lisp")(push (quote :kcl) *features*)' \ ++SETUP='(load "defsys.lisp")' \ + '(setq pcl::*default-pathname-extensions* (cons "lisp" "o"))' \ + '(setq pcl::*pathname-extensions* (cons "lisp" "o"))' \ + '(load "sys-proclaim.lisp")' \ +--- /dev/null ++++ gcl-2.6.12/pcl/package.lisp +@@ -0,0 +1,21 @@ ++(in-package :user) ++ ++(eval-when (compile load eval) ++ ++(if (find-package :walker) ++ (use-package '(:lisp) :walker) ++ (make-package :walker :use '(:lisp))) ++ ++(if (find-package :iterate) ++ (use-package '(:lisp :walker) :iterate) ++ (make-package :iterate :use '(:lisp :walker))) ++ ++(if (find-package :pcl) ++ (use-package '(:walker :iterate :lisp) :pcl) ++ (make-package :pcl :use '(:walker :iterate :lisp)))) ++ ++(in-package :pcl) ++(defvar *the-pcl-package* (find-package :pcl)) ++(defun load-truename (&optional errorp) *load-pathname*) ++(import 'si::(clines defentry defcfun object void int double)) ++(import 'si::compiler-let :walker) +--- gcl-2.6.12.orig/pcl/sys-proclaim.lisp ++++ gcl-2.6.12/pcl/sys-proclaim.lisp +@@ -1,775 +1,1044 @@ + +-(IN-PACKAGE "PCL") +-(PROCLAIM +- '(FTYPE (FUNCTION NIL T) +- INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST MAKE-ARG-INFO +- RENEW-SYS-FILES ALLOCATE-FUNCALLABLE-INSTANCE-1 +- SHOW-DFUN-CONSTRUCTORS MAKE-CACHE SHOW-EMF-CALL-TRACE +- INITIAL-DISPATCH-DFUN-INFO DISPATCH-DFUN-INFO +- IN-THE-COMPILER-P UPDATE-DISPATCH-DFUNS +- SHOW-FREE-CACHE-VECTORS NO-METHODS-DFUN-INFO +- %%ALLOCATE-INSTANCE--CLASS DEFAULT-METHOD-ONLY-DFUN-INFO +- BOOTSTRAP-META-BRAID GET-EFFECTIVE-METHOD-GENSYM +- STRUCTURE-FUNCTIONS-EXIST-P LIST-ALL-DFUNS MAKE-CPD +- CACHES-TO-ALLOCATE INITIAL-DFUN-INFO +- ALLOCATE-FUNCALLABLE-INSTANCE-2 BOOTSTRAP-BUILT-IN-CLASSES)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) *) DEFAULT-CODE-CONVERTER +- MAKE-FINAL-DISPATCH-DFUN PROTOTYPES-FOR-MAKE-METHOD-LAMBDA +- FIND-STRUCTURE-CLASS EARLY-COLLECT-INHERITANCE +- EMIT-ONE-INDEX-WRITERS NET-CODE-CONVERTER +- MAKE-DISPATCH-DFUN *NORMALIZE-TYPE COMPILE-IIS-FUNCTIONS +- GENERIC-FUNCTION-NAME-P EMIT-IN-CHECKING-CACHE-P +- EMIT-ONE-CLASS-READER GET-GENERIC-FUNCTION-INFO +- COMPUTE-APPLICABLE-METHODS-EMF ANALYZE-LAMBDA-LIST +- EMIT-ONE-INDEX-READERS EARLY-METHOD-FUNCTION PCL-DESCRIBE +- TYPE-FROM-SPECIALIZER FIND-WRAPPER METHOD-PROTOTYPE-FOR-GF +- SPECIALIZER-FROM-TYPE STRUCTURE-WRAPPER +- GET-DISPATCH-FUNCTION EMIT-TWO-CLASS-READER +- PARSE-METHOD-GROUP-SPECIFIER CLASS-EQ-TYPE +- EMIT-CONSTANT-VALUE EMIT-TWO-CLASS-WRITER +- CONVERT-TO-SYSTEM-TYPE PARSE-DEFMETHOD +- EMIT-ONE-CLASS-WRITER)) +-(PROCLAIM +- '(FTYPE (FUNCTION (*) T) |__si::MAKE-CACHING| |__si::MAKE-N-N| +- MAKE-INITIALIZE-INFO |__si::MAKE-NO-METHODS| +- |__si::MAKE-TWO-CLASS| INTERN-PV-TABLE +- |__si::MAKE-ARG-INFO| |__si::MAKE-ONE-INDEX-DFUN-INFO| +- FIX-EARLY-GENERIC-FUNCTIONS CALLED-FIN-WITHOUT-FUNCTION +- MAKE-FAST-METHOD-CALL STRING-APPEND |__si::MAKE-ONE-INDEX| +- |__si::MAKE-INITIAL| |__si::MAKE-CHECKING| ZERO +- |__si::MAKE-PV-TABLE| MAKE-PROGN FALSE MAKE-PV-TABLE +- WALKER::UNBOUND-LEXICAL-FUNCTION |__si::MAKE-DISPATCH| +- USE-PACKAGE-PCL TRUE |__si::MAKE-DEFAULT-METHOD-ONLY| +- |__si::MAKE-INITIAL-DISPATCH| |__si::MAKE-CONSTANT-VALUE| +- |__si::MAKE-DFUN-INFO| |__si::MAKE-STD-INSTANCE| +- MAKE-METHOD-CALL |__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| +- MAKE-FAST-INSTANCE-BOUNDP |__si::MAKE-ACCESSOR-DFUN-INFO| +- |STRUCTURE-OBJECT class constructor| |__si::MAKE-CACHE| +- |__si::MAKE-ONE-CLASS| PV-WRAPPERS-FROM-PV-ARGS)) +-(PROCLAIM '(FTYPE (FUNCTION (T) (OR CACHE NULL)) PV-TABLE-CACHE)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T *) *) MAKE-METHOD-FUNCTION-INTERNAL +- PARSE-METHOD-OR-SPEC MAKE-METHOD-LAMBDA-INTERNAL +- COERCE-TO-CLASS MAKE-FINAL-DFUN-INTERNAL GET-FUNCTION +- EXTRACT-DECLARATIONS COMPILE-LAMBDA GET-FUNCTION1 +- MAKE-CACHING-DFUN GET-METHOD-FUNCTION DISPATCH-DFUN-COST +- MACROEXPAND-ALL PARSE-SPECIALIZED-LAMBDA-LIST ENSURE-CLASS +- WALK-FORM MAKE-INSTANCE-1 GET-DFUN-CONSTRUCTOR +- MAP-ALL-CLASSES ENSURE-GENERIC-FUNCTION +- MAKE-CONSTANT-VALUE-DFUN)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T) T) ACCESSOR-MISS-FUNCTION ADD-TO-CVECTOR +- QUALIFIER-CHECK-RUNTIME SET-FUNCTION-PRETTY-ARGLIST +- ADD-DIRECT-SUBCLASSES REMOVE-METHOD SET-WRAPPER +- DOCTOR-DFUN-FOR-THE-DEBUGGER MAKE-PLIST +- SYMBOL-OR-CONS-LESSP MAKE-STD-BOUNDP-METHOD-FUNCTION +- UPDATE-CPL METHODS-CONVERTER MAKE-DFUN-ARG-LIST +- MAKE-DISCRIMINATING-FUNCTION-ARGLIST +- STANDARD-INSTANCE-ACCESS REMTAIL DO-SATISFIES-DEFTYPE +- CPL-FORWARD-REFERENCED-CLASS-ERROR FIND-STANDARD-II-METHOD +- MAKE-UNORDERED-METHODS-EMF UPDATE-INITIALIZE-INFO-INTERNAL +- ADD-METHOD COMPUTE-PV |SETF PCL FIND-CLASS-PREDICATE| +- PROCLAIM-DEFMETHOD UPDATE-ALL-PV-TABLE-CACHES +- ITERATE::SIMPLE-EXPAND-ITERATE-FORM CLASS-MIGHT-PRECEDE-P +- MEC-ALL-CLASSES SET-FUNCALLABLE-INSTANCE-FUNCTION +- MAKE-DFUN-LAMBDA-LIST CHECKING-DFUN-INFO +- METHOD-FUNCTION-RETURNING-T PV-WRAPPERS-FROM-ALL-WRAPPERS +- SET-METHODS ITERATE::MV-SETQ SUPERCLASSES-COMPATIBLE-P +- SLOT-EXISTS-P SWAP-WRAPPERS-AND-SLOTS DESCRIBE-PACKAGE +- VALUE-FOR-CACHING SAUT-NOT-PROTOTYPE +- SET-STANDARD-SVUC-METHOD PLIST-VALUE AUGMENT-TYPE +- UPDATE-CLASS N-N-DFUN-INFO VARIABLE-SPECIAL-P +- UPDATE-STD-OR-STR-METHODS ADD-FORMS MAKE-CAXR +- MAKE-DLAP-LAMBDA-LIST REDIRECT-EARLY-FUNCTION-INTERNAL +- GET-KEY-ARG1 EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +- MAKE-INTERNAL-READER-METHOD-FUNCTION |SETF PCL FIND-CLASS| +- COMPUTE-CALLS PROCLAIM-DEFGENERIC WALKER::NOTE-DECLARATION +- SYSTEM:%SET-COMPILED-FUNCTION-NAME VARIABLE-LEXICAL-P +- CANONICALIZE-DEFCLASS-OPTION RAISE-METATYPE +- PARSE-QUALIFIER-PATTERN SAUT-NOT-CLASS-EQ +- MAKE-PV-TABLE-INTERNAL WALKER::ENVIRONMENT-FUNCTION +- COMPUTE-APPLICABLE-METHODS-FUNCTION +- EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +- PV-TABLE-LOOKUP VARIABLE-CLASS +- MAKE-FAST-METHOD-CALL-LAMBDA-LIST |SETF PCL GDEFINITION| +- NET-CONSTANT-CONVERTER WALKER::VARIABLE-SYMBOL-MACRO-P +- SYMBOL-LESSP GF-MAKE-FUNCTION-FROM-EMF +- REMOVE-DIRECT-SUBCLASSES UPDATE-INITS +- |SETF PCL METHOD-FUNCTION-PLIST| COMPUTE-STD-CPL +- CPL-INCONSISTENT-ERROR CHANGE-CLASS-INTERNAL +- FIND-SLOT-DEFINITION COMPUTE-LAYOUT NO-SLOT +- %SET-CCLOSURE-ENV COMPUTE-CONSTANTS +- SET-STRUCTURE-SVUC-METHOD GET-KEY-ARG REMOVE-SLOT-ACCESSORS +- MAKE-CDXR MEMF-CONSTANT-CONVERTER BOOTSTRAP-SLOT-INDEX +- CLASS-CAN-PRECEDE-P MEC-ALL-CLASSES-INTERNAL +- CLASSES-HAVE-COMMON-SUBCLASS-P MAKE-CLASS-PREDICATE +- SAUT-NOT-CLASS DESTRUCTURE-INTERNAL +- ITERATE::EXTRACT-SPECIAL-BINDINGS MAKE-EARLY-ACCESSOR +- MAP-PV-TABLE-REFERENCES-OF MAKE-STD-WRITER-METHOD-FUNCTION +- FUNCALLABLE-STANDARD-INSTANCE-ACCESS +- METHOD-FUNCTION-RETURNING-NIL MEC-ALL-CLASS-LISTS +- ADD-SLOT-ACCESSORS EMIT-1-NIL-DLAP +- MAKE-STD-READER-METHOD-FUNCTION +- CANONICALIZE-SLOT-SPECIFICATION LIST-EQ REAL-REMOVE-METHOD +- WALKER::ENVIRONMENT-MACRO SAUT-NOT-EQL UPDATE-SLOTS +- DEAL-WITH-ARGUMENTS-OPTION PRINTING-RANDOM-THING-INTERNAL +- WALKER::WALK-REPEAT-EVAL +- PV-WRAPPERS-FROM-ALL-ARGS WALKER::NOTE-LEXICAL-BINDING)) +-(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 255)) CACHE-NKEYS)) +-(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 256)) CACHE-LINE-SIZE)) +-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T T) *) COMPUTE-CACHE-PARAMETERS)) +-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T *) *) FIND-FREE-CACHE-LINE)) +-(PROCLAIM '(FTYPE (FUNCTION (T) FIELD-TYPE) CACHE-FIELD)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) FUNCTION) CACHE-LIMIT-FN +- FAST-METHOD-CALL-FUNCTION METHOD-CALL-FUNCTION)) +-(MAPC (LAMBDA (COMPILER::X) +- (SETF (GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) T)) +- '(TRACE-METHOD-INTERNAL FDEFINE-CAREFULLY DO-STANDARD-DEFSETF-1 +- REDEFINE-FUNCTION)) +-(PROCLAIM +- '(FTYPE (FUNCTION (FIXNUM FIXNUM T) FIXNUM) +- COMPUTE-PRIMARY-CACHE-LOCATION)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T FIXNUM *) T) GET-CACHE-FROM-CACHE +- COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) (VALUES T T)) MAKE-KEYWORD +- MAKE-CLASS-PREDICATE-NAME)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T *) T) FIND-CLASS-PREDICATE FIND-CLASS-CELL +- USE-CONSTANT-VALUE-DFUN-P MAKE-EARLY-GF ITERATE::MAYBE-WARN +- TRACE-METHOD ALLOCATE-FUNCALLABLE-INSTANCE WALKER::RELIST +- UPDATE-DFUN USE-DISPATCH-DFUN-P PV-TABLE-LOOKUP-PV-ARGS +- MAKE-WRAPPER EARLY-METHOD-SPECIALIZERS +- INITIALIZE-METHOD-FUNCTION MAKE-FINAL-DFUN +- WALKER::WALKER-ENVIRONMENT-BIND-1 MAKE-TYPE-PREDICATE-NAME +- ALLOCATE-STRUCTURE-INSTANCE MAKE-SPECIALIZABLE +- CAPITALIZE-WORDS SET-DFUN ITERATE::FUNCTION-LAMBDA-P +- FIND-CLASS INITIALIZE-INTERNAL-SLOT-GFS SET-ARG-INFO +- WALKER::RELIST* ALLOCATE-STANDARD-INSTANCE)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T) *) SAUT-NOT ENSURE-CLASS-VALUES +- EMIT-CHECKING EMIT-DEFAULT-ONLY-FUNCTION EMIT-DEFAULT-ONLY +- SAUT-CLASS CLASS-APPLICABLE-USING-CLASS-P EMIT-CACHING +- DESTRUCTURE GET-NEW-FUNCTION-GENERATOR-INTERNAL +- COMPUTE-TEST MAKE-DIRECT-SLOTD SLOT-NAME-LISTS-FROM-SLOTS +- SAUT-EQL INSURE-DFUN CHECK-INITARGS-VALUES +- SET-FUNCTION-NAME INITIAL-DFUN COMPUTE-STD-CPL-PHASE-1 +- *SUBTYPEP COMPUTE-APPLICABLE-METHODS-USING-TYPES +- SDFUN-FOR-CACHING INVOKE-EMF SPLIT-DECLARATIONS +- GENERATE-FAST-CLASS-SLOT-ACCESS-P COMPUTE-CODE SLOT-VALUE +- SPECIALIZER-APPLICABLE-USING-TYPE-P SLOT-BOUNDP +- FORM-LIST-TO-LISP ITERATE::PARSE-DECLARATIONS +- MAKE-INSTANCE-FUNCTION-TRAP SAUT-PROTOTYPE +- MUTATE-SLOTS-AND-CALLS SAUT-AND SAUT-CLASS-EQ +- FIND-SUPERCLASS-CHAIN SLOT-UNBOUND-INTERNAL +- UPDATE-SLOT-VALUE-GF-INFO SLOT-MAKUNBOUND)) +-(PROCLAIM +- '(FTYPE (FUNCTION NIL *) EMIT-N-N-WRITERS EMIT-N-N-READERS +- COUNT-ALL-DFUNS)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) T) CHECKING-FUNCTION +- METHOD-CALL-CALL-METHOD-ARGS EARLY-COLLECT-CPL +- METHOD-FUNCTION-PV-TABLE ECD-OTHER-INITARGS +- BOOTSTRAP-CLASS-PREDICATES CONSTANT-SYMBOL-P GDEFINITION +- %FBOUNDP INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION +- MAKE-INSTANCE-FUNCTION-SYMBOL FGEN-TEST +- GF-PRECOMPUTE-DFUN-AND-EMF-P VARIABLE-GLOBALLY-SPECIAL-P +- SLOT-INITARGS-FROM-STRUCTURE-SLOTD ARG-INFO-P +- STRUCTURE-TYPE-INTERNAL-SLOTDS CCLOSUREP CHECKING-CACHE +- GF-LAMBDA-LIST +- MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- STRUCTURE-SVUC-METHOD DISPATCH-CACHE +- BOOTSTRAP-ACCESSOR-DEFINITIONS FINAL-ACCESSOR-DFUN-TYPE +- SETFBOUNDP ONE-CLASS-P EARLY-GF-P UPDATE-C-A-M-GF-INFO +- FGEN-GENSYMS SORT-SLOTS MAKE-CLASS-EQ-PREDICATE N-N-CACHE +- SFUN-P DFUN-ARG-SYMBOL +- INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION +- EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME +- MAKE-TYPE-PREDICATE SORT-CALLS +- MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION TWO-CLASS-WRAPPER1 +- USE-DEFAULT-METHOD-ONLY-DFUN-P FGEN-SYSTEM +- CACHING-DFUN-COST CPD-CLASS CACHING-CACHE +- INITIAL-DISPATCH-P LOOKUP-FGEN +- COMPUTE-APPLICABLE-METHODS-EMF-STD-P COMPUTE-LINE-SIZE +- GF-INFO-STATIC-C-A-M-EMF FAST-INSTANCE-BOUNDP-P +- N-N-ACCESSOR-TYPE KEYWORD-SPEC-NAME DEFAULT-TEST-CONVERTER +- RESET-INITIALIZE-INFO INITIAL-P +- INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL +- EXPAND-MAKE-INSTANCE-FORM STRUCTURE-SLOT-BOUNDP +- STANDARD-SVUC-METHOD TWO-CLASS-INDEX +- EARLY-CLASS-PRECEDENCE-LIST MAKE-INITIAL-DFUN GMAKUNBOUND +- METHODS-CONTAIN-EQL-SPECIALIZER-P EXPAND-SHORT-DEFCOMBIN +- ACCESSOR-DFUN-INFO-CACHE MAKE-CALL-METHODS +- STRUCTURE-SLOTD-NAME ALLOCATE-CACHE-VECTOR +- RESET-CLASS-INITIALIZE-INFO GET-SETF-FUNCTION-NAME +- METHOD-CALL-P LEGAL-CLASS-NAME-P EXTRACT-PARAMETERS +- EARLY-SLOT-DEFINITION-NAME ECD-METACLASS DISPATCH-P +- METHOD-FUNCTION-PLIST %STD-INSTANCE-SLOTS +- CANONICAL-SLOT-NAME CONSTANT-VALUE-DFUN-INFO +- FUNCTION-RETURNING-T FUNCTION-PRETTY-ARGLIST +- STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST CHECK-WRAPPER-VALIDITY +- INITIALIZE-INFO-P CPD-AFTER +- MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- ONE-INDEX-INDEX WALKER::ENV-DECLARATIONS +- STRUCTURE-SLOTD-TYPE MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION +- EVAL-FORM LIST-DFUN +- INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION +- CACHE-OWNER FAST-METHOD-CALL-PV-CELL DFUN-INFO-P +- UPDATE-PV-TABLE-CACHE-INFO EARLY-CLASS-SLOTDS +- FUNCTION-RETURNING-NIL ECD-CLASS-NAME +- TWO-CLASS-ACCESSOR-TYPE EARLY-CLASS-DEFINITION +- FAST-METHOD-CALL-P INITIALIZE-INFO-CACHED-RI-VALID-P +- COMPUTE-MCASE-PARAMETERS GF-DFUN-INFO +- INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST +- EARLY-METHOD-LAMBDA-LIST ONE-CLASS-WRAPPER0 +- CLASS-PRECEDENCE-DESCRIPTION-P GET-MAKE-INSTANCE-FUNCTIONS +- EXPAND-LONG-DEFCOMBIN MAP-SPECIALIZERS +- EARLY-CLASS-DIRECT-SUBCLASSES WALKER::ENV-WALK-FORM +- STRUCTURE-TYPE-INCLUDED-TYPE-NAME +- ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE GBOUNDP ECD-SOURCE +- CLASS-FROM-TYPE INITIALIZE-INFO-CACHED-NEW-KEYS +- ARG-INFO-NKEYS DEFAULT-CONSTANT-CONVERTER +- INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION +- STORE-FGEN EARLY-METHOD-STANDARD-ACCESSOR-P +- INTERN-FUNCTION-NAME NET-TEST-CONVERTER ARG-INFO-KEY/REST-P +- COMPLICATED-INSTANCE-CREATION-METHOD +- FTYPE-DECLARATION-FROM-LAMBDA-LIST +- GENERIC-CLOBBERS-FUNCTION DEFAULT-STRUCTUREP +- GF-INFO-C-A-M-EMF-STD-P ARG-INFO-VALID-P +- FORMAT-CYCLE-REASONS FAST-METHOD-CALL-ARG-INFO +- GET-MAKE-INSTANCE-FUNCTION-SYMBOL %STD-INSTANCE-WRAPPER +- SLOT-BOUNDP-SYMBOL INITIAL-CACHE +- METHOD-FUNCTION-NEEDS-NEXT-METHODS-P +- SYSTEM:%COMPILED-FUNCTION-NAME MAKE-CALLS-TYPE-DECLARATION +- UPDATE-CLASS-CAN-PRECEDE-P SLOT-READER-SYMBOL FREE-CACHE +- DNET-METHODS-P CONSTANT-VALUE-CACHE +- GET-BUILT-IN-CLASS-SYMBOL UPDATE-GFS-OF-CLASS +- ONE-CLASS-CACHE STD-INSTANCE-P ONE-INDEX-CACHE +- STRUCTURE-SLOTD-WRITER-FUNCTION FGEN-GENERATOR-LAMBDA +- EXTRACT-SPECIALIZER-NAMES EARLY-SLOT-DEFINITION-LOCATION +- DO-STANDARD-DEFSETFS-FOR-DEFCLASS %CCLOSURE-ENV +- EARLY-ACCESSOR-METHOD-SLOT-NAME ACCESSOR-DFUN-INFO-P +- INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS SLOT-WRITER-SYMBOL +- ARG-INFO-KEYWORDS INITIALIZE-INFO-WRAPPER +- FAST-METHOD-CALL-NEXT-METHOD-CALL INITIAL-DISPATCH-CACHE +- NEXT-WRAPPER-FIELD +- INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST CHECKING-P +- EXTRACT-REQUIRED-PARAMETERS GET-BUILT-IN-WRAPPER-SYMBOL +- INITIALIZE-INFO-CACHED-CONSTANTS +- STRUCTURE-SLOTD-READER-FUNCTION EARLY-METHOD-CLASS +- STRUCTURE-OBJECT-P DEFAULT-METHOD-ONLY-CACHE +- PARSE-SPECIALIZERS INTERN-EQL-SPECIALIZER +- COMPILE-LAMBDA-DEFERRED MAKE-CONSTANT-FUNCTION +- MAKE-PV-TYPE-DECLARATION ARG-INFO-APPLYP +- GET-PV-CELL-FOR-CLASS ONE-INDEX-DFUN-INFO-INDEX +- UNENCAPSULATED-FDEFINITION CHECK-CACHE +- WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE +- INITIALIZE-INFO-KEY ONE-CLASS-INDEX SYSTEM:%STRUCTURE-NAME +- SLOT-VECTOR-SYMBOL MAKE-PV-TABLE-TYPE-DECLARATION +- TWO-CLASS-CACHE PROCLAIM-INCOMPATIBLE-SUPERCLASSES +- BUILT-IN-OR-STRUCTURE-WRAPPER1 ECD-SUPERCLASS-NAMES +- STRUCTURE-TYPE CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P +- N-N-P INTERNED-SYMBOL-P DEFAULT-METHOD-ONLY-P +- EARLY-CLASS-SLOTS NO-METHODS-P ARG-INFO-NUMBER-OPTIONAL +- ONE-INDEX-P GET-MAKE-INSTANCE-FUNCTION EARLY-CLASS-NAME +- METHOD-FUNCTION-FROM-FAST-FUNCTION MAKE-PERMUTATION-VECTOR +- ONE-CLASS-ACCESSOR-TYPE TWO-CLASS-P BUILT-IN-WRAPPER-OF +- FREE-CACHE-VECTOR GET-CACHE-VECTOR ARG-INFO-LAMBDA-LIST +- UPDATE-GF-INFO ONE-INDEX-DFUN-INFO-CACHE %SYMBOL-FUNCTION +- ACCESSOR-DFUN-INFO-ACCESSOR-TYPE FUNCALLABLE-INSTANCE-P +- ECD-CANONICAL-SLOTS EARLY-COLLECT-SLOTS +- INITIALIZE-INFO-CACHED-VALID-P UNPARSE-SPECIALIZERS +- GF-INFO-FAST-MF-P +- MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +- EARLY-CLASS-NAME-OF GF-DFUN-CACHE CLASS-PREDICATE +- EXTRACT-LAMBDA-LIST CLASS-OF COPY-CACHE SYMBOL-PKG-NAME +- ONE-INDEX-DFUN-INFO-P WRAPPER-OF METHOD-FUNCTION-METHOD +- CPD-SUPERS DEFAULT-STRUCTURE-INSTANCE-P +- STRUCTURE-SLOTD-INIT-FORM EARLY-METHOD-QUALIFIERS +- LIST-LARGE-CACHE UPDATE-GF-SIMPLE-ACCESSOR-TYPE TYPE-CLASS +- MAKE-EQL-PREDICATE EARLY-GF-NAME UPDATE-ALL-C-A-M-GF-INFO +- FLUSH-CACHE-VECTOR-INTERNAL ITERATE::SEQUENCE-ACCESSOR +- MAP-ALL-GENERIC-FUNCTIONS STRUCTURE-TYPE-P +- FIND-CYCLE-REASONS DEFAULT-STRUCTURE-TYPE +- COMPUTE-CLASS-SLOTS WRAPPER-FOR-STRUCTURE +- INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION +- USE-CACHING-DFUN-P EARLY-COLLECT-DEFAULT-INITARGS +- DEFAULT-SECONDARY-DISPATCH-FUNCTION ONE-INDEX-ACCESSOR-TYPE +- WALKER::ENV-WALK-FUNCTION WALKER::ENV-LOCK +- STRUCTURE-SLOTD-ACCESSOR-SYMBOL +- METHOD-LL->GENERIC-FUNCTION-LL CACHE-P WRAPPER-FIELD +- INITIALIZE-INFO-BOUND-SLOTS DEFAULT-CONSTANTP +- MAKE-FUNCTION-INLINE COMPUTE-STD-CPL-PHASE-2 +- CACHING-DFUN-INFO CONSTANT-VALUE-P +- WALKER::GET-WALKER-TEMPLATE ARG-INFO-METATYPES COUNT-DFUN +- MAKE-INITFUNCTION WALKER::ENV-LEXICAL-VARIABLES PV-TABLEP +- COMPILE-LAMBDA-UNCOMPILED UNDEFMETHOD-1 +- GF-INFO-SIMPLE-ACCESSOR-TYPE FORCE-CACHE-FLUSHES +- DFUN-INFO-CACHE GFS-OF-TYPE TWO-CLASS-WRAPPER0 +- ITERATE::VARIABLES-FROM-LET SHOW-DFUN-COSTS +- ARG-INFO-PRECEDENCE FGEN-GENERATOR +- RESET-CLASS-INITIALIZE-INFO-1 CACHING-P NO-METHODS-CACHE)) +-(PROCLAIM +- '(FTYPE (FUNCTION (*) *) INVALID-METHOD-ERROR +- METHOD-COMBINATION-ERROR UNTRACE-METHOD +- UPDATE-MAKE-INSTANCE-FUNCTION-TABLE LIST-LARGE-CACHES)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) LIST) CACHE-OVERFLOW PV-TABLE-SLOT-NAME-LISTS +- PV-TABLE-CALL-LIST)) +-(PROCLAIM '(FTYPE (FUNCTION (T) BOOLEAN) CACHE-VALUEP)) +-(PROCLAIM '(FTYPE (FUNCTION NIL FIXNUM) GET-WRAPPER-CACHE-NUMBER)) +-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T) T) %CCLOSURE-ENV-NTHCDR)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T) *) +- COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL +- WALK-METHOD-LAMBDA +- |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +- |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +- |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +- ADD-METHOD-DECLARATIONS +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +- MAKE-TWO-CLASS-ACCESSOR-DFUN +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +- |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T T) *) +- |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| +- ITERATE::ITERATE-TRANSFORM-BODY)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T *) *) ITERATE::RENAME-LET-BINDINGS +- MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T) *) CONSTANT-VALUE-MISS +- EMIT-ONE-OR-N-INDEX-READER/WRITER CACHING-MISS +- CACHE-MISS-VALUES +- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +- WALKER::WALK-FORM-INTERNAL +- GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION +- SLOT-VALUE-USING-CLASS-DFUN SLOT-BOUNDP-USING-CLASS-DFUN +- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +- |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +- MAKE-FINAL-CONSTANT-VALUE-DFUN CHECK-METHOD-ARG-INFO +- MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION +- MAKE-FINAL-CACHING-DFUN EMIT-READER/WRITER-FUNCTION +- SET-SLOT-VALUE +- |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| +- WALKER::WALK-LET-IF ACCESSOR-VALUES1 +- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +- ITERATE::EXPAND-INTO-LET OPTIMIZE-SLOT-VALUE-BY-CLASS-P +- ITERATE::RENAME-VARIABLES +- EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION CHECKING-MISS +- |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +- ACCESSOR-VALUES-INTERNAL GET-CLASS-SLOT-VALUE-1 +- LOAD-LONG-DEFCOMBIN +- |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +- MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION +- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| +- MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION +- EMIT-READER/WRITER GENERATING-LISP +- MAKE-FINAL-N-N-ACCESSOR-DFUN +- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| +- ITERATE::WALK-GATHERING-BODY +- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +- GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- CONVERT-METHODS)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T) *) BOOTSTRAP-ACCESSOR-DEFINITION +- INITIALIZE-INSTANCE-SIMPLE-FUNCTION +- |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| +- ORDER-SPECIALIZERS MAKE-ONE-CLASS-ACCESSOR-DFUN +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +- |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +- GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION +- |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +- SETF-SLOT-VALUE-USING-CLASS-DFUN +- GENERATE-DISCRIMINATION-NET +- MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN +- |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +- |(FAST-METHOD DESCRIBE-OBJECT (T T))| ACCESSOR-VALUES +- LOAD-SHORT-DEFCOMBIN SET-CLASS-SLOT-VALUE-1 +- |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| +- REAL-MAKE-METHOD-LAMBDA EMIT-CHECKING-OR-CACHING-FUNCTION +- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +- |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +- MAKE-SHARED-INITIALIZE-FORM-LIST +- |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +- ACCESSOR-MISS |(FAST-METHOD NO-APPLICABLE-METHOD (T))| +- MAKE-FINAL-CHECKING-DFUN +- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +- GET-ACCESSOR-METHOD-FUNCTION +- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| +- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +- |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +- |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| +- EMIT-CHECKING-OR-CACHING)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T) *) MEMF-CODE-CONVERTER +- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- GENERATE-DISCRIMINATION-NET-INTERNAL +- DO-SHORT-METHOD-COMBINATION +- MAKE-LONG-METHOD-COMBINATION-FUNCTION +- CACHE-MISS-VALUES-INTERNAL)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T *) *) MAKE-ONE-INDEX-ACCESSOR-DFUN +- WALKER::WALK-DECLARATIONS GET-SECONDARY-DISPATCH-FUNCTION)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T *) *) SLOT-VALUE-OR-DEFAULT NESTED-WALK-FORM +- LOAD-DEFGENERIC MAKE-ACCESSOR-TABLE +- MAKE-DEFAULT-INITARGS-FORM-LIST +- GET-EFFECTIVE-METHOD-FUNCTION MAKE-CHECKING-DFUN +- GET-COMPLEX-INITIALIZATION-FUNCTIONS MAKE-N-N-ACCESSOR-DFUN +- GET-SIMPLE-INITIALIZATION-FUNCTION MAKE-FINAL-ACCESSOR-DFUN +- TYPES-FROM-ARGUMENTS MAKE-EFFECTIVE-METHOD-FUNCTION +- COMPUTE-SECONDARY-DISPATCH-FUNCTION)) +-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T *) *) REAL-MAKE-A-METHOD)) +-(PROCLAIM '(FTYPE (FUNCTION (T) SIMPLE-VECTOR) CACHE-VECTOR)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T) T) BOOTSTRAP-MAKE-SLOT-DEFINITION +- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- LOAD-DEFCLASS MAKE-EARLY-CLASS-DEFINITION +- WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 OPTIMIZE-GF-CALL +- EMIT-SLOT-ACCESS REAL-LOAD-DEFCLASS SET-ARG-INFO1)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T) T) +- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +- |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +- EXPAND-EMF-CALL-METHOD +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +- COMPUTE-PV-SLOT +- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +- UPDATE-SLOTS-IN-PV BOOTSTRAP-MAKE-SLOT-DEFINITIONS +- WALKER::WALK-TEMPLATE-HANDLE-REPEAT WALKER::WALK-BINDINGS-1 +- OPTIMIZE-ACCESSOR-CALL REAL-MAKE-METHOD-INITARGS-FORM +- |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +- |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| +- MAKE-EMF-CACHE MAKE-METHOD-INITARGS-FORM-INTERNAL1 +- BOOTSTRAP-ACCESSOR-DEFINITIONS1 +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +- MAKE-INSTANCE-FUNCTION-COMPLEX MAKE-FGEN +- |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +- MAKE-FINAL-ORDINARY-DFUN-INTERNAL +- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- MAKE-INSTANCE-FUNCTION-SIMPLE OPTIMIZE-INSTANCE-ACCESS +- MAKE-PARAMETER-REFERENCES +- GET-MAKE-INSTANCE-FUNCTION-INTERNAL +- |(FAST-METHOD SLOT-UNBOUND (T T T))| +- |(FAST-METHOD (SETF DOCUMENTATION) (T T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- LOAD-FUNCTION-GENERATOR +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +- OPTIMIZE-GENERIC-FUNCTION-CALL)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T *) T) EMIT-FETCH-WRAPPER FILL-CACHE +- GET-METHOD CHECK-INITARGS-2-PLIST MAKE-EMF-CALL +- CHECK-INITARGS-1 WALKER::WALK-ARGLIST REAL-GET-METHOD +- CAN-OPTIMIZE-ACCESS1 CHECK-INITARGS-2-LIST)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T) T) ONE-CLASS-DFUN-INFO +- |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| SORT-METHODS +- OPTIMIZE-GF-CALL-INTERNAL WALKER::WALK-LABELS +- |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +- WALKER::WALK-DO +- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +- ITERATE::RENAME-AND-CAPTURE-VARIABLES EXPAND-DEFGENERIC +- |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +- FLUSH-CACHE-TRAP WALKER::WALK-MACROLET +- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +- COMPUTE-EFFECTIVE-METHOD OPTIMIZE-SET-SLOT-VALUE +- WALKER::WALK-SYMBOL-MACROLET OPTIMIZE-SLOT-BOUNDP +- |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| +- GET-FUNCTION-GENERATOR FIX-SLOT-ACCESSORS +- SET-FUNCTION-NAME-1 WALKER::WALK-LET EMIT-BOUNDP-CHECK +- INITIALIZE-INTERNAL-SLOT-GFS* PRINT-CACHE WALKER::WALK-IF +- WALKER::WALK-SETQ WALKER::RELIST-INTERNAL +- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +- EMIT-1-T-DLAP CAN-OPTIMIZE-ACCESS WALKER::WALK-COMPILER-LET +- |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +- |SETF PCL METHOD-FUNCTION-GET| +- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +- GET-NEW-FUNCTION-GENERATOR WALKER::WALK-UNEXPECTED-DECLARE +- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +- VARIABLE-DECLARATION +- |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +- MAP-ALL-ORDERS ONE-INDEX-DFUN-INFO WALKER::WALK-LAMBDA +- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +- NOTE-PV-TABLE-REFERENCE WALKER::RECONS +- STANDARD-COMPUTE-EFFECTIVE-METHOD +- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +- |SETF PCL PLIST-VALUE| EMIT-GREATER-THAN-1-DLAP +- MAKE-METHOD-SPEC ITERATE::OPTIMIZE-GATHERING-FORM +- OPTIMIZE-SLOT-VALUE PRINT-STD-INSTANCE COMPUTE-PRECEDENCE +- WALKER::WALK-TAGBODY WALKER::WALK-NAMED-LAMBDA +- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +- SKIP-FAST-SLOT-ACCESS-P TRACE-EMF-CALL-INTERNAL +- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +- ITERATE::SIMPLE-EXPAND-GATHERING-FORM +- |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +- SORT-APPLICABLE-METHODS SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P +- OBSOLETE-INSTANCE-TRAP WALKER::WALK-PROG +- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +- INVALIDATE-WRAPPER +- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- ENTRY-IN-CACHE-P WALKER::WALK-TAGBODY-1 +- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +- MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +- WALKER::WALK-LOCALLY WALKER::WALK-MULTIPLE-VALUE-BIND +- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| +- WRAP-METHOD-GROUP-SPECIFIER-BINDINGS WALKER::WALK-LET* +- |(FAST-METHOD CLASS-PREDICATE-NAME (T))| +- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +- |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +- EMIT-SLOT-READ-FORM FIRST-FORM-TO-LISP +- MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +- WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL +- WALKER::WALK-PROG* WALKER::WALK-FLET +- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +- MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +- MAKE-METHOD-INITARGS-FORM-INTERNAL WALKER::WALK-DO* +- MAKE-TOP-LEVEL-FORM +- |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| +- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| +- ITERATE::OPTIMIZE-ITERATE-FORM DECLARE-STRUCTURE +- MAKE-DFUN-CALL ITERATE::VARIABLE-SAME-P +- |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- WALKER::WALK-MULTIPLE-VALUE-SETQ CONVERT-TABLE +- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +- |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))|)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T) T) +- |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +- EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY +- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +- WALKER::WALK-LET/LET* +- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +- MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE +- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- |(FAST-METHOD DOCUMENTATION (T))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +- MAYBE-EXPAND-ACCESSOR-FORM BOOTSTRAP-SET-SLOT +- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +- WALKER::WALK-TEMPLATE +- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +- |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +- |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| +- GET-WRAPPERS-FROM-CLASSES +- |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +- MAKE-EFFECTIVE-METHOD-FUNCTION1 +- |(FAST-METHOD PRINT-OBJECT (CLASS T))| +- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +- EXPAND-CACHE EXPAND-DEFCLASS +- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +- |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL +- |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| +- TWO-CLASS-DFUN-INFO +- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- |(FAST-METHOD PRINT-OBJECT (T T))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +- FILL-CACHE-P MEMF-TEST-CONVERTER +- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +- WALKER::WALK-BINDINGS-2 +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +- |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +- |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +- WALKER::WALK-DO/DO* ADJUST-CACHE +- |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +- OPTIMIZE-READER +- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +- EXPAND-SYMBOL-MACROLET-INTERNAL +- |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +- |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| +- MAKE-DISPATCH-LAMBDA +- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| +- INITIALIZE-INSTANCE-SIMPLE +- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +- OPTIMIZE-WRITER +- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- LOAD-PRECOMPILED-IIS-ENTRY +- LOAD-PRECOMPILED-DFUN-CONSTRUCTOR +- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| +- WALKER::WALK-PROG/PROG* +- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +- |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD MAKE-INSTANCE (CLASS))| +- |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))|)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T *) T) COMPUTE-SECONDARY-DISPATCH-FUNCTION1 +- FIND-CLASS-PREDICATE-FROM-CELL +- ENSURE-GENERIC-FUNCTION-USING-CLASS GET-DECLARATION +- METHOD-FUNCTION-GET CPL-ERROR EMIT-MISS +- PRECOMPUTE-EFFECTIVE-METHODS GET-METHOD-FUNCTION-PV-CELL +- MAP-CACHE EXPAND-EFFECTIVE-METHOD-FUNCTION +- MAKE-EMF-FROM-METHOD GET-EFFECTIVE-METHOD-FUNCTION1 +- REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION +- NAMED-OBJECT-PRINT-FUNCTION +- MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE PROBE-CACHE +- INITIALIZE-INFO REAL-ENSURE-GF-USING-CLASS--NULL +- FIND-CLASS-FROM-CELL WALKER::CONVERT-MACRO-TO-LAMBDA +- REAL-ADD-METHOD RECORD-DEFINITION)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T *) T) MAKE-DEFMETHOD-FORM +- MAKE-DEFMETHOD-FORM-INTERNAL LOAD-DEFMETHOD +- EARLY-MAKE-A-METHOD)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T *) T) EMIT-DLAP +- GET-SECONDARY-DISPATCH-FUNCTION1)) +-(PROCLAIM '(FTYPE (FUNCTION (T T FIXNUM) T) COMPUTE-STD-CPL-PHASE-3)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T T T) T) +- GET-SECONDARY-DISPATCH-FUNCTION2)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T *) T) REAL-ADD-NAMED-METHOD +- EARLY-ADD-NAMED-METHOD FILL-DFUN-CACHE)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T T) T) +- |(FAST-METHOD SLOT-MISSING (T T T T))| +- LOAD-DEFMETHOD-INTERNAL EXPAND-DEFMETHOD)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T FIXNUM) T) GET-CACHE +- FILL-CACHE-FROM-CACHE-P)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T T T T T T T T T *) T) +- BOOTSTRAP-INITIALIZE-CLASS)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) FIXNUM) N-N-ACCESSORS-LIMIT-FN +- FAST-INSTANCE-BOUNDP-INDEX PV-TABLE-PV-SIZE +- ARG-INFO-NUMBER-REQUIRED EARLY-CLASS-SIZE DEFAULT-LIMIT-FN +- CHECKING-LIMIT-FN ONE-INDEX-LIMIT-FN CPD-COUNT CACHE-COUNT +- PV-CACHE-LIMIT-FN CACHING-LIMIT-FN)) +-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) POWER-OF-TWO-CEILING)) +-(PROCLAIM '(FTYPE (FUNCTION (T T *) (VALUES T T)) SYMBOL-APPEND)) +-(PROCLAIM '(FTYPE (FUNCTION (T STREAM T) T) PRINT-DFUN-INFO)) +-(PROCLAIM +- '(FTYPE (FUNCTION (T) NON-NEGATIVE-FIXNUM) CACHE-NLINES CACHE-MASK +- CACHE-MAX-LOCATION CACHE-SIZE)) ++(COMMON-LISP::IN-PACKAGE "PCL") ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) ++ PCL::CACHE-LIMIT-FN PCL::FAST-METHOD-CALL-FUNCTION ++ PCL::METHOD-CALL-FUNCTION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ PCL::DISPATCH-DFUN-INFO PCL::DEFAULT-METHOD-ONLY-DFUN-INFO ++ PCL::MAKE-CACHE PCL::BOOTSTRAP-BUILT-IN-CLASSES ++ PCL::RENEW-SYS-FILES PCL::SHOW-EMF-CALL-TRACE PCL::MAKE-CPD ++ PCL::BOOTSTRAP-META-BRAID PCL::CACHES-TO-ALLOCATE ++ PCL::LIST-ALL-DFUNS PCL::INITIAL-DISPATCH-DFUN-INFO ++ PCL::INITIAL-DFUN-INFO PCL::%%ALLOCATE-INSTANCE--CLASS ++ PCL::MAKE-ARG-INFO PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2 ++ PCL::SHOW-FREE-CACHE-VECTORS PCL::UPDATE-DISPATCH-DFUNS ++ PCL::GET-EFFECTIVE-METHOD-GENSYM PCL::IN-THE-COMPILER-P ++ PCL::SHOW-DFUN-CONSTRUCTORS PCL::NO-METHODS-DFUN-INFO ++ PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 ++ PCL::STRUCTURE-FUNCTIONS-EXIST-P)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) ++ PCL::CACHE-FIELD)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ COMMON-LISP::SIMPLE-VECTOR) ++ PCL::CACHE-VECTOR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::INTEGER 1 256)) ++ PCL::CACHE-LINE-SIZE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::INTEGER 1 255)) ++ PCL::CACHE-NKEYS)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1 ++ PCL::FDEFINE-CAREFULLY PCL::TRACE-METHOD-INTERNAL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++ PCL::SYMBOL-APPEND)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL ++ PCL::GENERIC-CLOBBERS-FUNCTION PCL::STRUCTURE-SLOTD-TYPE ++ WALKER::GET-WALKER-TEMPLATE PCL::COMPILE-LAMBDA-UNCOMPILED ++ PCL::EXTRACT-LAMBDA-LIST PCL::DEFAULT-METHOD-ONLY-P ++ PCL::DISPATCH-CACHE PCL::STRUCTURE-SLOTD-NAME ++ PCL::FAST-METHOD-CALL-P PCL::SFUN-P ++ PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST ++ PCL::EARLY-CLASS-DEFINITION PCL::CONSTANT-SYMBOL-P ++ PCL::ARG-INFO-LAMBDA-LIST WALKER::ENV-LEXICAL-VARIABLES ++ PCL::INTERN-EQL-SPECIALIZER PCL::PARSE-SPECIALIZERS ++ PCL::%STD-INSTANCE-WRAPPER PCL::UPDATE-ALL-C-A-M-GF-INFO ++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION ++ PCL::STORE-FGEN PCL::COMPUTE-MCASE-PARAMETERS ++ PCL::INTERNED-SYMBOL-P PCL::MAKE-CALL-METHODS ++ PCL::USE-CACHING-DFUN-P PCL::LEGAL-CLASS-NAME-P ++ WALKER::VARIABLE-GLOBALLY-SPECIAL-P PCL::FUNCTION-RETURNING-T ++ PCL::METHOD-FUNCTION-METHOD PCL::GET-BUILT-IN-CLASS-SYMBOL ++ PCL::DEFAULT-STRUCTURE-TYPE PCL::GF-DFUN-INFO PCL::CACHING-P ++ PCL::FREE-CACHE-VECTOR PCL::ONE-CLASS-CACHE ++ PCL::DEFAULT-TEST-CONVERTER PCL::UNDEFMETHOD-1 ++ PCL::MAKE-INITFUNCTION PCL::GET-CACHE-VECTOR ++ PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::GF-INFO-FAST-MF-P ++ PCL::ECD-SOURCE PCL::INITIAL-P PCL::ARG-INFO-APPLYP ++ PCL::ARG-INFO-KEYWORDS ++ PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION ++ PCL::CACHING-DFUN-COST PCL::INITIAL-DISPATCH-P PCL::EVAL-FORM ++ PCL::MAKE-CONSTANT-FUNCTION PCL::FUNCTION-RETURNING-NIL ++ PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::FGEN-GENSYMS ++ PCL::EXPAND-SHORT-DEFCOMBIN WALKER::ENV-LOCK ++ PCL::INITIALIZE-INFO-CACHED-CONSTANTS ++ PCL::INITIALIZE-INFO-WRAPPER ++ PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME PCL::TWO-CLASS-INDEX ++ PCL::ONE-INDEX-ACCESSOR-TYPE ++ PCL::EARLY-COLLECT-DEFAULT-INITARGS WALKER::ENV-WALK-FORM ++ PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::MAKE-FUNCTION-INLINE ++ PCL::FLUSH-CACHE-VECTOR-INTERNAL ++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION ++ PCL::FGEN-GENERATOR PCL::CONSTANT-VALUE-P ++ PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION ++ PCL::EARLY-CLASS-PRECEDENCE-LIST PCL::SLOT-BOUNDP-SYMBOL ++ PCL::ARG-INFO-NUMBER-OPTIONAL ++ PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::GET-PV-CELL-FOR-CLASS ++ PCL::CHECKING-FUNCTION PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P ++ PCL::INITIAL-DISPATCH-CACHE PCL::STRUCTURE-SVUC-METHOD ++ PCL::NO-METHODS-CACHE PCL::GF-DFUN-CACHE PCL::%CCLOSURE-ENV ++ PCL::CONSTANT-VALUE-CACHE PCL::BUILT-IN-WRAPPER-OF ++ PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P ++ PCL::EARLY-COLLECT-CPL COMMON-LISP::CLASS-OF ++ PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::SYMBOL-PKG-NAME ++ PCL::GDEFINITION ++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION ++ PCL::ACCESSOR-DFUN-INFO-CACHE PCL::EXTRACT-SPECIALIZER-NAMES ++ PCL::CHECK-WRAPPER-VALIDITY PCL::MAKE-INITIAL-DFUN ++ PCL::WRAPPER-FIELD PCL::EARLY-SLOT-DEFINITION-LOCATION ++ PCL::EARLY-GF-P PCL::GF-INFO-STATIC-C-A-M-EMF PCL::LOOKUP-FGEN ++ PCL::MAKE-PV-TYPE-DECLARATION ++ PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS ++ PCL::EARLY-METHOD-CLASS ++ PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION ++ WALKER::ENV-DECLARATIONS PCL::ALLOCATE-CACHE-VECTOR ++ PCL::FUNCTION-PRETTY-ARGLIST ++ PCL::EARLY-CLASS-DIRECT-SUBCLASSES ++ PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P ++ PCL::MAKE-CLASS-EQ-PREDICATE PCL::ECD-OTHER-INITARGS ++ PCL::GBOUNDP PCL::METHOD-FUNCTION-PV-TABLE ++ WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE ++ PCL::MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::FIND-CYCLE-REASONS PCL::FGEN-TEST ++ PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::FREE-CACHE ++ PCL::TYPE-CLASS PCL::INITIAL-CACHE ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS ++ PCL::STRUCTURE-SLOTD-WRITER-FUNCTION ++ PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION ++ PCL::EARLY-COLLECT-SLOTS PCL::LIST-DFUN ++ PCL::EXPAND-MAKE-INSTANCE-FORM PCL::N-N-CACHE ++ PCL::MAKE-TYPE-PREDICATE PCL::INTERN-FUNCTION-NAME ++ PCL::GET-MAKE-INSTANCE-FUNCTIONS WALKER::ENV-WALK-FUNCTION ++ PCL::TWO-CLASS-CACHE PCL::MAKE-CALLS-TYPE-DECLARATION ++ PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION ++ PCL::INITIALIZE-INFO-KEY PCL::GF-LAMBDA-LIST ++ ITERATE::VARIABLES-FROM-LET PCL::COMPUTE-CLASS-SLOTS ++ PCL::DFUN-ARG-SYMBOL PCL::CHECKING-P PCL::ARG-INFO-P ++ PCL::INITIALIZE-INFO-CACHED-RI-VALID-P PCL::CHECKING-CACHE ++ PCL::METHOD-FUNCTION-PLIST PCL::STRUCTURE-OBJECT-P ++ PCL::ARG-INFO-PRECEDENCE PCL::ONE-CLASS-INDEX ++ PCL::STD-INSTANCE-P PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::EARLY-SLOT-DEFINITION-NAME PCL::UNPARSE-SPECIALIZERS ++ PCL::STRUCTURE-TYPE-P PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE ++ PCL::PV-TABLEP PCL::CLASS-FROM-TYPE ++ PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::STRUCTURE-TYPE ++ PCL::MAKE-EQL-PREDICATE PCL::TWO-CLASS-ACCESSOR-TYPE ++ PCL::DEFAULT-STRUCTURE-INSTANCE-P ++ PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME ++ PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::GFS-OF-TYPE ++ PCL::DEFAULT-STRUCTUREP PCL::EARLY-CLASS-NAME-OF ++ PCL::%STD-INSTANCE-SLOTS PCL::ONE-INDEX-INDEX PCL::WRAPPER-OF ++ PCL::ARG-INFO-VALID-P PCL::KEYWORD-SPEC-NAME ++ PCL::METHOD-CALL-P PCL::SHOW-DFUN-COSTS PCL::DFUN-INFO-CACHE ++ PCL::DEFAULT-CONSTANT-CONVERTER ITERATE::SEQUENCE-ACCESSOR ++ PCL::COUNT-DFUN PCL::EXPAND-LONG-DEFCOMBIN ++ PCL::CACHING-DFUN-INFO PCL::INITIALIZE-INFO-CACHED-VALID-P ++ PCL::FAST-INSTANCE-BOUNDP-P PCL::ARG-INFO-METATYPES ++ PCL::EXTRACT-PARAMETERS PCL::GF-INFO-C-A-M-EMF-STD-P ++ PCL::FINAL-ACCESSOR-DFUN-TYPE PCL::GMAKUNBOUND ++ PCL::FAST-METHOD-CALL-ARG-INFO PCL::COMPUTE-LINE-SIZE ++ PCL::ONE-INDEX-CACHE PCL::NO-METHODS-P ++ PCL::COMPUTE-STD-CPL-PHASE-2 ++ PCL::COMPLICATED-INSTANCE-CREATION-METHOD ++ PCL::MAKE-PERMUTATION-VECTOR PCL::CONSTANT-VALUE-DFUN-INFO ++ PCL::TWO-CLASS-WRAPPER1 PCL::MAP-ALL-GENERIC-FUNCTIONS ++ PCL::CLASS-PREDICATE SYSTEM::%STRUCTURE-NAME ++ PCL::RESET-CLASS-INITIALIZE-INFO ++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::EARLY-CLASS-NAME ++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::SLOT-READER-SYMBOL ++ PCL::ARG-INFO-NKEYS PCL::METHOD-CALL-CALL-METHOD-ARGS ++ PCL::CCLOSUREP PCL::DEFAULT-METHOD-ONLY-CACHE ++ PCL::NEXT-WRAPPER-FIELD PCL::SLOT-WRITER-SYMBOL ++ PCL::ACCESSOR-DFUN-INFO-P ++ PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::EXTRACT-REQUIRED-PARAMETERS PCL::FORMAT-CYCLE-REASONS ++ PCL::UNENCAPSULATED-FDEFINITION ++ PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::ONE-CLASS-P ++ PCL::ECD-METACLASS PCL::METHOD-LL->GENERIC-FUNCTION-LL ++ PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::ONE-INDEX-P ++ PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST ++ PCL::ECD-CANONICAL-SLOTS ++ PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P ++ PCL::INITIALIZE-INFO-CACHED-NEW-KEYS ++ PCL::STRUCTURE-SLOTD-READER-FUNCTION ++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST ++ PCL::DISPATCH-P PCL::LIST-LARGE-CACHE ++ PCL::FAST-METHOD-CALL-PV-CELL PCL::GET-MAKE-INSTANCE-FUNCTION ++ PCL::DNET-METHODS-P PCL::STRUCTURE-SLOTD-INIT-FORM ++ PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::ONE-CLASS-ACCESSOR-TYPE ++ PCL::RESET-INITIALIZE-INFO PCL::STANDARD-SVUC-METHOD ++ PCL::DEFAULT-CONSTANTP PCL::UPDATE-C-A-M-GF-INFO ++ PCL::ONE-INDEX-DFUN-INFO-CACHE PCL::EARLY-CLASS-SLOTS ++ PCL::CPD-SUPERS PCL::FGEN-GENERATOR-LAMBDA ++ PCL::ECD-SUPERCLASS-NAMES PCL::ECD-CLASS-NAME PCL::SETFBOUNDP ++ PCL::GET-SETF-FUNCTION-NAME PCL::DFUN-INFO-P ++ PCL::SLOT-VECTOR-SYMBOL PCL::INITIALIZE-INFO-P ++ PCL::TWO-CLASS-P PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE ++ PCL::COPY-CACHE PCL::MAKE-PV-TABLE-TYPE-DECLARATION ++ PCL::SORT-CALLS PCL::STRUCTURE-SLOT-BOUNDP PCL::%FBOUNDP ++ PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::UPDATE-GF-INFO ++ PCL::WRAPPER-FOR-STRUCTURE PCL::FUNCALLABLE-INSTANCE-P ++ PCL::CPD-CLASS PCL::EARLY-METHOD-STANDARD-ACCESSOR-P ++ PCL::SORT-SLOTS PCL::CANONICAL-SLOT-NAME ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++ PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::%SYMBOL-FUNCTION ++ PCL::EARLY-METHOD-LAMBDA-LIST PCL::ONE-INDEX-DFUN-INFO-INDEX ++ PCL::N-N-ACCESSOR-TYPE PCL::CACHING-CACHE ++ PCL::EARLY-CLASS-SLOTDS PCL::ONE-INDEX-DFUN-INFO-P ++ SYSTEM::%COMPILED-FUNCTION-NAME ++ PCL::BOOTSTRAP-CLASS-PREDICATES PCL::NET-TEST-CONVERTER ++ PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS PCL::TWO-CLASS-WRAPPER0 ++ PCL::MAP-SPECIALIZERS PCL::EARLY-GF-NAME PCL::N-N-P ++ PCL::FGEN-SYSTEM PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P ++ PCL::UPDATE-GFS-OF-CLASS PCL::ONE-CLASS-WRAPPER0 ++ PCL::CPD-AFTER ++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION ++ PCL::CACHE-P PCL::EARLY-METHOD-QUALIFIERS PCL::CHECK-CACHE ++ PCL::FORCE-CACHE-FLUSHES PCL::CACHE-OWNER ++ PCL::COMPILE-LAMBDA-DEFERRED PCL::ARG-INFO-KEY/REST-P)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES ++ PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD ++ COMMON-LISP::METHOD-COMBINATION-ERROR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ PCL::NON-NEGATIVE-FIXNUM) ++ PCL::CACHE-MAX-LOCATION PCL::CACHE-NLINES PCL::CACHE-SIZE ++ PCL::CACHE-MASK)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION ++ ITERATE::SIMPLE-EXPAND-ITERATE-FORM PCL::ADD-DIRECT-SUBCLASSES ++ PCL::PROCLAIM-DEFMETHOD PCL::UPDATE-INITIALIZE-INFO-INTERNAL ++ PCL::RAISE-METATYPE PCL::CLASS-CAN-PRECEDE-P ++ WALKER::VARIABLE-SPECIAL-P PCL::GF-MAKE-FUNCTION-FROM-EMF ++ PCL::|SETF PCL METHOD-FUNCTION-PLIST| ++ PCL::SET-FUNCTION-PRETTY-ARGLIST ++ PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS ++ PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST ++ PCL::DEAL-WITH-ARGUMENTS-OPTION WALKER::NOTE-DECLARATION ++ PCL::MAKE-CLASS-PREDICATE PCL::VALUE-FOR-CACHING ++ PCL::EMIT-1-NIL-DLAP PCL::MAKE-CAXR PCL::SYMBOL-LESSP ++ PCL::GET-KEY-ARG1 PCL::ADD-FORMS ++ PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++ PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER ++ PCL::CLASSES-HAVE-COMMON-SUBCLASS-P PCL::N-N-DFUN-INFO ++ PCL::CANONICALIZE-SLOT-SPECIFICATION ++ PCL::REDIRECT-EARLY-FUNCTION-INTERNAL ++ PCL::UPDATE-STD-OR-STR-METHODS PCL::%SET-CCLOSURE-ENV ++ PCL::QUALIFIER-CHECK-RUNTIME ++ PCL::MAKE-STD-READER-METHOD-FUNCTION ++ PCL::ADD-SLOT-ACCESSORS PCL::ADD-TO-CVECTOR ++ PCL::COMPUTE-LAYOUT PCL::DESTRUCTURE-INTERNAL ++ PCL::SUPERCLASSES-COMPATIBLE-P ++ PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION ITERATE::MV-SETQ ++ PCL::COMPUTE-STD-CPL PCL::SET-METHODS PCL::CHECKING-DFUN-INFO ++ ITERATE::EXTRACT-SPECIAL-BINDINGS PCL::SWAP-WRAPPERS-AND-SLOTS ++ PCL::CANONICALIZE-DEFCLASS-OPTION PCL::MAKE-CDXR ++ PCL::PRINTING-RANDOM-THING-INTERNAL COMMON-LISP::ADD-METHOD ++ PCL::STANDARD-INSTANCE-ACCESS ++ SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::FIND-SLOT-DEFINITION ++ PCL::CLASS-MIGHT-PRECEDE-P ++ PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::SAUT-NOT-EQL ++ PCL::SET-WRAPPER PCL::SET-STANDARD-SVUC-METHOD ++ PCL::SAUT-NOT-PROTOTYPE PCL::ACCESSOR-MISS-FUNCTION ++ PCL::NO-SLOT PCL::REMTAIL PCL::PV-WRAPPERS-FROM-ALL-ARGS ++ PCL::UPDATE-CLASS PCL::AUGMENT-TYPE PCL::MAKE-EARLY-ACCESSOR ++ PCL::MAKE-PLIST PCL::MEC-ALL-CLASSES-INTERNAL ++ PCL::MAKE-STD-WRITER-METHOD-FUNCTION ++ PCL::PARSE-QUALIFIER-PATTERN PCL::MEMF-CONSTANT-CONVERTER ++ PCL::|SETF PCL FIND-CLASS-PREDICATE| ++ PCL::MAKE-UNORDERED-METHODS-EMF WALKER::ENVIRONMENT-FUNCTION ++ PCL::MEC-ALL-CLASS-LISTS PCL::SAUT-NOT-CLASS-EQ ++ PCL::DO-SATISFIES-DEFTYPE PCL::SET-STRUCTURE-SVUC-METHOD ++ PCL::MAKE-DLAP-LAMBDA-LIST PCL::METHOD-FUNCTION-RETURNING-T ++ PCL::COMPUTE-CALLS PCL::REMOVE-SLOT-ACCESSORS ++ PCL::UPDATE-ALL-PV-TABLE-CACHES PCL::MAKE-DFUN-LAMBDA-LIST ++ WALKER::NOTE-LEXICAL-BINDING PCL::REMOVE-DIRECT-SUBCLASSES ++ PCL::MAP-PV-TABLE-REFERENCES-OF PCL::COMPUTE-CONSTANTS ++ PCL::METHOD-FUNCTION-RETURNING-NIL PCL::METHODS-CONVERTER ++ PCL::PV-TABLE-LOOKUP PCL::DESCRIBE-PACKAGE ++ COMMON-LISP::SLOT-EXISTS-P PCL::MAKE-PV-TABLE-INTERNAL ++ PCL::SAUT-NOT-CLASS PCL::|SETF PCL FIND-CLASS| ++ PCL::UPDATE-INITS PCL::UPDATE-CPL ++ PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++ PCL::COMPUTE-PV WALKER::VARIABLE-LEXICAL-P ++ PCL::PROCLAIM-DEFGENERIC PCL::MAKE-DFUN-ARG-LIST ++ PCL::GET-KEY-ARG COMMON-LISP::REMOVE-METHOD ++ PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS PCL::VARIABLE-CLASS ++ PCL::UPDATE-SLOTS PCL::SYMBOL-OR-CONS-LESSP ++ PCL::MEC-ALL-CLASSES PCL::LIST-EQ ++ PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION ++ WALKER::WALK-REPEAT-EVAL WALKER::ENVIRONMENT-MACRO ++ WALKER::VARIABLE-SYMBOL-MACRO-P ++ PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST ++ PCL::BOOTSTRAP-SLOT-INDEX PCL::PLIST-VALUE ++ PCL::CHANGE-CLASS-INTERNAL PCL::NET-CONSTANT-CONVERTER ++ PCL::|SETF PCL GDEFINITION| PCL::FIND-STANDARD-II-METHOD)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ WALKER::WALK-FORM PCL::MAKE-INSTANCE-1 ++ PCL::EXTRACT-DECLARATIONS PCL::GET-FUNCTION ++ WALKER::MACROEXPAND-ALL PCL::ALLOCATE-STRUCTURE-INSTANCE ++ PCL::MAKE-FINAL-DFUN-INTERNAL PCL::GET-METHOD-FUNCTION ++ PCL::COERCE-TO-CLASS PCL::MAP-ALL-CLASSES PCL::ENSURE-CLASS ++ PCL::PARSE-METHOD-OR-SPEC COMMON-LISP::ENSURE-GENERIC-FUNCTION ++ PCL::MAKE-CACHING-DFUN PCL::GET-FUNCTION1 ++ PCL::GET-DFUN-CONSTRUCTOR PCL::MAKE-CONSTANT-VALUE-DFUN ++ PCL::MAKE-METHOD-FUNCTION-INTERNAL PCL::COMPILE-LAMBDA ++ PCL::PARSE-SPECIALIZED-LAMBDA-LIST PCL::DISPATCH-DFUN-COST ++ PCL::MAKE-METHOD-LAMBDA-INTERNAL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++ PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::FIND-CLASS-FROM-CELL PCL::GET-METHOD-FUNCTION-PV-CELL ++ PCL::PROBE-CACHE PCL::NAMED-OBJECT-PRINT-FUNCTION ++ PCL::PRECOMPUTE-EFFECTIVE-METHODS ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE ++ PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::MAKE-EMF-FROM-METHOD ++ PCL::EMIT-MISS PCL::REAL-ENSURE-GF-USING-CLASS--NULL ++ PCL::RECORD-DEFINITION WALKER::CONVERT-MACRO-TO-LAMBDA ++ PCL::INITIALIZE-INFO PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION ++ PCL::METHOD-FUNCTION-GET PCL::FIND-CLASS-PREDICATE-FROM-CELL ++ PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS ++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 PCL::GET-DECLARATION ++ PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION ++ PCL::MAP-CACHE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++ WALKER::WALK-PROG/PROG* ++ PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ WALKER::WALK-BINDINGS-2 ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ WALKER::WALK-DO/DO* ++ PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::|(FAST-METHOD DOCUMENTATION (T))| ++ PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| ++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++ PCL::INITIALIZE-INSTANCE-SIMPLE PCL::BOOTSTRAP-SET-SLOT ++ PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| ++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ PCL::FILL-CACHE-P ++ PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++ PCL::OPTIMIZE-WRITER PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL ++ PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 ++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++ PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++ PCL::ADJUST-CACHE ++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR ++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ PCL::MEMF-TEST-CONVERTER ++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++ WALKER::WALK-TEMPLATE PCL::TWO-CLASS-DFUN-INFO ++ PCL::EXPAND-CACHE ++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++ PCL::GET-WRAPPERS-FROM-CLASSES ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::LOAD-PRECOMPILED-IIS-ENTRY ++ PCL::|(FAST-METHOD PRINT-OBJECT (T T))| ++ PCL::EXPAND-SYMBOL-MACROLET-INTERNAL ++ PCL::MAYBE-EXPAND-ACCESSOR-FORM ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY ++ PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++ PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++ PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::EXPAND-DEFCLASS ++ PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++ WALKER::WALK-LET/LET* PCL::MAKE-DISPATCH-LAMBDA ++ PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| ++ PCL::OPTIMIZE-READER ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::OPTIMIZE-SET-SLOT-VALUE ++ PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++ PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++ PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++ PCL::PRINT-CACHE WALKER::WALK-UNEXPECTED-DECLARE ++ ITERATE::OPTIMIZE-ITERATE-FORM ++ PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++ WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::FIRST-FORM-TO-LISP ++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++ WALKER::WALK-LABELS ++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ PCL::ONE-CLASS-DFUN-INFO PCL::GET-FUNCTION-GENERATOR ++ WALKER::RELIST-INTERNAL PCL::NOTE-PV-TABLE-REFERENCE ++ WALKER::WALK-LAMBDA PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS ++ PCL::ONE-INDEX-DFUN-INFO PCL::MAP-ALL-ORDERS ++ PCL::OPTIMIZE-GF-CALL-INTERNAL PCL::COMPUTE-PRECEDENCE ++ WALKER::WALK-DO PCL::PRINT-STD-INSTANCE ++ PCL::OBSOLETE-INSTANCE-TRAP PCL::SORT-APPLICABLE-METHODS ++ PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ PCL::EMIT-GREATER-THAN-1-DLAP ++ PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ WALKER::WALK-FLET ++ PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++ PCL::|SETF PCL PLIST-VALUE| WALKER::WALK-PROG* ++ WALKER::VARIABLE-DECLARATION ++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1 ++ WALKER::WALK-MACROLET PCL::CAN-OPTIMIZE-ACCESS ++ WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL ++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++ PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++ PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++ PCL::EMIT-BOUNDP-CHECK PCL::|SETF PCL METHOD-FUNCTION-GET| ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++ PCL::MAKE-METHOD-SPEC PCL::FLUSH-CACHE-TRAP WALKER::WALK-IF ++ PCL::OPTIMIZE-SLOT-BOUNDP ++ PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD ++ WALKER::WALK-MULTIPLE-VALUE-BIND ++ ITERATE::RENAME-AND-CAPTURE-VARIABLES WALKER::WALK-LET* ++ WALKER::WALK-DO* ++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++ PCL::INVALIDATE-WRAPPER ++ PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++ PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++ ITERATE::SIMPLE-EXPAND-GATHERING-FORM PCL::ENTRY-IN-CACHE-P ++ WALKER::WALK-LOCALLY PCL::OPTIMIZE-SLOT-VALUE ++ PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL ++ PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++ PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++ PCL::TRACE-EMF-CALL-INTERNAL WALKER::WALK-SYMBOL-MACROLET ++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ PCL::CONVERT-TABLE ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ PCL::INITIALIZE-INTERNAL-SLOT-GFS* ++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++ PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++ PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++ WALKER::WALK-SETQ PCL::EXPAND-DEFGENERIC ++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++ ITERATE::OPTIMIZE-GATHERING-FORM PCL::FIX-SLOT-ACCESSORS ++ PCL::EMIT-SLOT-READ-FORM WALKER::WALK-PROG ++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++ WALKER::WALK-NAMED-LAMBDA PCL::GET-NEW-FUNCTION-GENERATOR ++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ WALKER::WALK-TAGBODY ++ PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++ WALKER::WALK-COMPILER-LET PCL::DECLARE-STRUCTURE ++ WALKER::WALK-LET ITERATE::VARIABLE-SAME-P ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++ PCL::EMIT-1-T-DLAP PCL::MAKE-DFUN-CALL ++ PCL::COMPUTE-EFFECTIVE-METHOD PCL::SORT-METHODS ++ WALKER::WALK-TAGBODY-1 ++ PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ PCL::MAKE-TOP-LEVEL-FORM ++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++ WALKER::RECONS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::UPDATE-SLOTS-IN-PV PCL::MAKE-INSTANCE-FUNCTION-COMPLEX ++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL ++ PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ PCL::MAKE-INSTANCE-FUNCTION-SIMPLE ++ PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++ PCL::COMPUTE-PV-SLOT PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 ++ PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| ++ PCL::OPTIMIZE-INSTANCE-ACCESS ++ PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++ PCL::REAL-MAKE-METHOD-INITARGS-FORM ++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++ PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL ++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS ++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| ++ PCL::MAKE-PARAMETER-REFERENCES ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::OPTIMIZE-ACCESSOR-CALL ++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT WALKER::WALK-BINDINGS-1 ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 ++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::MAKE-FGEN ++ PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++ PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++ PCL::OPTIMIZE-GENERIC-FUNCTION-CALL ++ PCL::LOAD-FUNCTION-GENERATOR PCL::MAKE-EMF-CACHE ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::EXPAND-EMF-CALL-METHOD)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::EXPAND-DEFMETHOD PCL::LOAD-DEFMETHOD-INTERNAL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::FILL-CACHE PCL::CAN-OPTIMIZE-ACCESS1 PCL::MAKE-EMF-CALL ++ PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-2-LIST ++ PCL::GET-METHOD PCL::CHECK-INITARGS-2-PLIST ++ PCL::CHECK-INITARGS-1 PCL::REAL-GET-METHOD ++ WALKER::WALK-ARGLIST)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::GET-SECONDARY-DISPATCH-FUNCTION2)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::LOAD-DEFMETHOD PCL::MAKE-DEFMETHOD-FORM ++ PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM-INTERNAL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::SET-ARG-INFO1 PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION ++ PCL::LOAD-DEFCLASS PCL::REAL-LOAD-DEFCLASS ++ PCL::OPTIMIZE-GF-CALL WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 ++ PCL::EMIT-SLOT-ACCESS PCL::MAKE-EARLY-CLASS-DEFINITION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::EARLY-ADD-NAMED-METHOD PCL::FILL-DFUN-CACHE ++ PCL::REAL-ADD-NAMED-METHOD)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::BOOTSTRAP-INITIALIZE-CLASS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM) ++ COMMON-LISP::T) ++ PCL::COMPUTE-STD-CPL-PHASE-3)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::FIXNUM) ++ COMMON-LISP::T) ++ PCL::FILL-CACHE-FROM-CACHE-P PCL::GET-CACHE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) ++ PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW ++ PCL::PV-TABLE-SLOT-NAME-LISTS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::COMPUTE-CACHE-PARAMETERS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ PCL::FIND-FREE-CACHE-LINE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN) ++ PCL::CACHE-VALUEP)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ PCL::DEFAULT-CODE-CONVERTER PCL::EMIT-IN-CHECKING-CACHE-P ++ PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-TWO-CLASS-WRITER ++ PCL::PARSE-METHOD-GROUP-SPECIFIER PCL::EMIT-ONE-CLASS-WRITER ++ PCL::EMIT-ONE-INDEX-WRITERS PCL::FIND-STRUCTURE-CLASS ++ PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA PCL::MAKE-DISPATCH-DFUN ++ PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EARLY-METHOD-FUNCTION ++ PCL::NET-CODE-CONVERTER PCL::GET-DISPATCH-FUNCTION ++ PCL::STRUCTURE-WRAPPER PCL::FIND-WRAPPER PCL::CLASS-EQ-TYPE ++ PCL::TYPE-FROM-SPECIALIZER PCL::SPECIALIZER-FROM-TYPE ++ PCL::PCL-DESCRIBE PCL::PARSE-DEFMETHOD ++ PCL::ANALYZE-LAMBDA-LIST PCL::EMIT-ONE-CLASS-READER ++ PCL::EARLY-COLLECT-INHERITANCE PCL::GET-GENERIC-FUNCTION-INFO ++ PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE ++ PCL::EMIT-ONE-INDEX-READERS PCL::GENERIC-FUNCTION-NAME-P ++ PCL::CONVERT-TO-SYSTEM-TYPE PCL::MAKE-FINAL-DISPATCH-DFUN ++ PCL::EMIT-TWO-CLASS-READER PCL::*NORMALIZE-TYPE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| ++ PCL::MAKE-FAST-INSTANCE-BOUNDP PCL::MAKE-INITIALIZE-INFO ++ PCL::|STRUCTURE-OBJECT class constructor| ++ PCL::|__si::MAKE-CACHE| PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| ++ PCL::TRUE PCL::|__si::MAKE-PV-TABLE| ++ PCL::|__si::MAKE-ONE-INDEX| WALKER::UNBOUND-LEXICAL-FUNCTION ++ PCL::|__si::MAKE-CHECKING| PCL::MAKE-PV-TABLE ++ PCL::|__si::MAKE-NO-METHODS| PCL::MAKE-METHOD-CALL ++ PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL ++ PCL::INTERN-PV-TABLE PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| ++ PCL::|__si::MAKE-DISPATCH| ++ PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| ++ PCL::|__si::MAKE-ARG-INFO| PCL::FIX-EARLY-GENERIC-FUNCTIONS ++ PCL::ZERO PCL::MAKE-PROGN PCL::|__si::MAKE-INITIAL| ++ PCL::|__si::MAKE-ONE-CLASS| PCL::|__si::MAKE-DFUN-INFO| ++ PCL::|__si::MAKE-CONSTANT-VALUE| ++ PCL::|__si::MAKE-STD-INSTANCE| PCL::PV-WRAPPERS-FROM-PV-ARGS ++ PCL::|__si::MAKE-TWO-CLASS| PCL::|__si::MAKE-N-N| ++ PCL::|__si::MAKE-CACHING| PCL::FALSE PCL::STRING-APPEND ++ PCL::|__si::MAKE-INITIAL-DISPATCH| PCL::MAKE-FAST-METHOD-CALL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ PCL::ARG-INFO-NUMBER-REQUIRED PCL::PV-TABLE-PV-SIZE ++ PCL::CACHE-COUNT PCL::PV-CACHE-LIMIT-FN PCL::CHECKING-LIMIT-FN ++ PCL::CACHING-LIMIT-FN PCL::N-N-ACCESSORS-LIMIT-FN ++ PCL::DEFAULT-LIMIT-FN PCL::EARLY-CLASS-SIZE PCL::CPD-COUNT ++ PCL::ONE-INDEX-LIMIT-FN PCL::FAST-INSTANCE-BOUNDP-INDEX)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++ PCL::POWER-OF-TWO-CEILING)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::MAKE-TYPE-PREDICATE-NAME PCL::MAKE-FINAL-DFUN ++ PCL::CAPITALIZE-WORDS PCL::SET-DFUN ITERATE::MAYBE-WARN ++ PCL::MAKE-EARLY-GF PCL::USE-DISPATCH-DFUN-P WALKER::RELIST ++ PCL::MAKE-SPECIALIZABLE PCL::PV-TABLE-LOOKUP-PV-ARGS ++ PCL::ALLOCATE-STANDARD-INSTANCE ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE ++ PCL::USE-CONSTANT-VALUE-DFUN-P ITERATE::FUNCTION-LAMBDA-P ++ PCL::UPDATE-DFUN PCL::SET-ARG-INFO ++ PCL::EARLY-METHOD-SPECIALIZERS PCL::MAKE-WRAPPER ++ PCL::FIND-CLASS-CELL WALKER::WALKER-ENVIRONMENT-BIND-1 ++ PCL::TRACE-METHOD WALKER::RELIST* COMMON-LISP::FIND-CLASS ++ PCL::INITIALIZE-INTERNAL-SLOT-GFS PCL::FIND-CLASS-PREDICATE ++ PCL::INITIALIZE-METHOD-FUNCTION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::SAUT-NOT PCL::INVOKE-EMF PCL::SAUT-PROTOTYPE ++ PCL::COMPUTE-CODE ITERATE::PARSE-DECLARATIONS ++ PCL::SDFUN-FOR-CACHING ++ PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES ++ PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL ++ PCL::SLOT-NAME-LISTS-FROM-SLOTS PCL::DESTRUCTURE ++ PCL::SPLIT-DECLARATIONS PCL::MAKE-DIRECT-SLOTD ++ PCL::FORM-LIST-TO-LISP PCL::EMIT-CHECKING ++ PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::COMPUTE-TEST ++ PCL::SET-FUNCTION-NAME COMMON-LISP::SLOT-BOUNDP PCL::SAUT-AND ++ PCL::EMIT-CACHING PCL::INITIAL-DFUN ++ COMMON-LISP::SLOT-MAKUNBOUND COMMON-LISP::SLOT-VALUE ++ PCL::UPDATE-SLOT-VALUE-GF-INFO ++ PCL::CLASS-APPLICABLE-USING-CLASS-P ++ PCL::CPL-INCONSISTENT-ERROR PCL::*SUBTYPEP ++ PCL::SLOT-UNBOUND-INTERNAL ++ PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P ++ PCL::CHECK-INITARGS-VALUES PCL::ENSURE-CLASS-VALUES ++ PCL::SAUT-EQL PCL::REAL-REMOVE-METHOD PCL::EMIT-DEFAULT-ONLY ++ PCL::INSURE-DFUN PCL::EMIT-DEFAULT-ONLY-FUNCTION ++ PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN ++ PCL::SAUT-CLASS PCL::MAKE-INSTANCE-FUNCTION-TRAP ++ PCL::SAUT-CLASS-EQ PCL::COMPUTE-STD-CPL-PHASE-1 ++ PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL)) ++ PCL::PV-TABLE-CACHE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ WALKER::WALK-DECLARATIONS PCL::GET-SECONDARY-DISPATCH-FUNCTION ++ PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::MAKE-SHARED-INITIALIZE-FORM-LIST PCL::ACCESSOR-MISS ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++ PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| ++ PCL::SET-CLASS-SLOT-VALUE-1 ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| ++ PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION ++ PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN ++ PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION ++ PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN ++ PCL::LOAD-SHORT-DEFCOMBIN PCL::EMIT-CHECKING-OR-CACHING ++ PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++ PCL::MAKE-FINAL-CHECKING-DFUN ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ PCL::ACCESSOR-VALUES ++ PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ PCL::REAL-MAKE-METHOD-LAMBDA ++ PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++ PCL::GET-ACCESSOR-METHOD-FUNCTION ++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++ PCL::ORDER-SPECIALIZERS ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| ++ PCL::GENERATE-DISCRIMINATION-NET ++ PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++ PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++ PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITION ++ PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION ++ PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION ++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++ PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION ++ PCL::CONVERT-METHODS WALKER::WALK-LET-IF ++ PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES-INTERNAL ++ PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ PCL::LOAD-LONG-DEFCOMBIN PCL::CHECK-METHOD-ARG-INFO ++ PCL::ACCESSOR-VALUES1 ++ PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++ PCL::GENERATING-LISP PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN ++ WALKER::WALK-FORM-INTERNAL PCL::CONSTANT-VALUE-MISS ++ PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS ++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++ PCL::SLOT-BOUNDP-USING-CLASS-DFUN PCL::CHECKING-MISS ++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++ PCL::EMIT-READER/WRITER ITERATE::EXPAND-INTO-LET ++ PCL::GET-CLASS-SLOT-VALUE-1 ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION ++ PCL::MAKE-FINAL-CACHING-DFUN ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++ PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++ PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P PCL::SET-SLOT-VALUE ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER ++ ITERATE::RENAME-VARIABLES ++ PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ ITERATE::WALK-GATHERING-BODY PCL::CACHE-MISS-VALUES ++ PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION ++ PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER ++ PCL::GENERATE-DISCRIMINATION-NET-INTERNAL ++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION ++ PCL::CACHE-MISS-VALUES-INTERNAL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++ PCL::ADD-METHOD-DECLARATIONS ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++ PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++ PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::WALK-METHOD-LAMBDA ++ PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ PCL::REAL-MAKE-A-METHOD)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ PCL::MAKE-DEFAULT-INITARGS-FORM-LIST ++ PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS ++ PCL::SLOT-VALUE-OR-DEFAULT ++ PCL::GET-SIMPLE-INITIALIZATION-FUNCTION PCL::REAL-ADD-METHOD ++ PCL::LOAD-DEFGENERIC PCL::CPL-ERROR ++ PCL::MAKE-FINAL-ACCESSOR-DFUN PCL::MAKE-N-N-ACCESSOR-DFUN ++ PCL::TYPES-FROM-ARGUMENTS PCL::MAKE-ACCESSOR-TABLE ++ PCL::MAKE-CHECKING-DFUN WALKER::NESTED-WALK-FORM ++ PCL::GET-EFFECTIVE-METHOD-FUNCTION ++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ ITERATE::ITERATE-TRANSFORM-BODY ++ PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| ++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1 ++ ITERATE::RENAME-LET-BINDINGS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION ++ PCL::GET-CACHE-FROM-CACHE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::%CCLOSURE-ENV-NTHCDR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::PRINT-DFUN-INFO)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-WRITERS ++ PCL::EMIT-N-N-READERS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) ++ PCL::GET-WRAPPER-CACHE-NUMBER)) + (IN-PACKAGE "PCL") + +-(DOLIST (V '(DISASSEMBLE |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| +- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| +- |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)| +- |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)| ++(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| +- |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| ++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| + ADD-READER-METHOD + SHORT-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT +- REMOVE-READER-METHOD |LISP::T class predicate| +- EQL-SPECIALIZER-P |(SETF GENERIC-FUNCTION-NAME)| +- OBJECT-PLIST SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL +- |PCL::STANDARD-METHOD-COMBINATION class predicate| +- |PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION class predicate| +- |PCL::STANDARD-DIRECT-SLOT-DEFINITION class predicate| ++ REMOVE-READER-METHOD EQL-SPECIALIZER-P ++ |(SETF GENERIC-FUNCTION-NAME)| OBJECT-PLIST ++ SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL + |PCL::STANDARD-SLOT-DEFINITION class predicate| +- |PCL::STANDARD-OBJECT class predicate| ++ |PCL::STANDARD-DIRECT-SLOT-DEFINITION class predicate| ++ |PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION class predicate| ++ |PCL::STANDARD-METHOD-COMBINATION class predicate| + |(FAST-READER-METHOD SLOT-OBJECT METHOD)| +- |PCL::BUILT-IN-CLASS class predicate| SPECIALIZER-TYPE +- |LISP::RATIONAL class predicate| +- |LISP::RATIO class predicate| GF-DFUN-STATE ++ SPECIALIZER-TYPE GF-DFUN-STATE + |(SETF GENERIC-FUNCTION-METHOD-CLASS)| +- |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| + |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| ++ |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| + |(SETF GENERIC-FUNCTION-METHOD-COMBINATION)| + CLASS-DEFSTRUCT-CONSTRUCTOR +- |(FAST-READER-METHOD DEFINITION-SOURCE-MIXIN SOURCE)| + |(FAST-READER-METHOD SLOT-OBJECT SOURCE)| ++ |(FAST-READER-METHOD DEFINITION-SOURCE-MIXIN SOURCE)| + METHOD-FAST-FUNCTION |(SETF GENERIC-FUNCTION-METHODS)| + |(SETF GF-PRETTY-ARGLIST)| +- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| +- |(FAST-READER-METHOD SLOT-OBJECT ARG-INFO)| +- |(FAST-READER-METHOD SLOT-CLASS INITIALIZE-INFO)| + |(FAST-READER-METHOD SLOT-OBJECT INITIALIZE-INFO)| ++ |(FAST-READER-METHOD SLOT-CLASS INITIALIZE-INFO)| ++ |(FAST-READER-METHOD SLOT-OBJECT ARG-INFO)| ++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| + SPECIALIZERP EXACT-CLASS-SPECIALIZER-P +- |(FAST-READER-METHOD PCL-CLASS WRAPPER)| + |(FAST-READER-METHOD SLOT-OBJECT WRAPPER)| +- |(FAST-READER-METHOD SLOT-DEFINITION INITARGS)| ++ |(FAST-READER-METHOD PCL-CLASS WRAPPER)| + |(FAST-READER-METHOD SLOT-OBJECT INITARGS)| +- |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)| +- |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| +- |(FAST-READER-METHOD SLOT-OBJECT OPERATOR)| ++ |(FAST-READER-METHOD SLOT-DEFINITION INITARGS)| + |(FAST-READER-METHOD SHORT-METHOD-COMBINATION OPERATOR)| +- |LISP::CHARACTER class predicate| ++ |(FAST-READER-METHOD SLOT-OBJECT OPERATOR)| ++ |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| ++ |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)| + COMPATIBLE-META-CLASS-CHANGE-P +- |LISP::SEQUENCE class predicate| +- |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)| + |(FAST-READER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| ++ |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)| + |(BOUNDP READER-FUNCTION)| TRACE-METHOD-INTERNAL + |(BOUNDP PREDICATE-NAME)| |(BOUNDP READERS)| + UPDATE-GF-DFUN |(BOUNDP CLASS-PRECEDENCE-LIST)| +- |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP DOCUMENTATION)| +- |(BOUNDP LOCATION)| SPECIALIZER-OBJECT ++ |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)| ++ |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT + |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)| + ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)| + |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)| +@@ -783,158 +1052,146 @@ + CLASS-EQ-SPECIALIZER-P + |(FAST-BOUNDP-METHOD SLOT-OBJECT SOURCE)| SLOTS-FETCHER + |(SETF SLOT-ACCESSOR-STD-P)| REMOVE-WRITER-METHOD +- |(BOUNDP INITFUNCTION)| |(BOUNDP WRITER-FUNCTION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT ARG-INFO)| ++ |(BOUNDP WRITER-FUNCTION)| |(BOUNDP INITFUNCTION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITIALIZE-INFO)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT ARG-INFO)| + STRUCTURE-CLASS-P |(BOUNDP WRITERS)| +- |(BOUNDP INITFORM)| ++ |(BOUNDP INITFORM)| |SETF COMMON-LISP CLASS-NAME| + |(FAST-BOUNDP-METHOD SLOT-OBJECT WRAPPER)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITARGS)| +- |LISP::BIT-VECTOR class predicate| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| + UPDATE-CONSTRUCTORS |(BOUNDP SLOT-NAME)| + |(SETF SLOT-DEFINITION-INITARGS)| |(BOUNDP ALLOCATION)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| +- DOCUMENTATION |(BOUNDP GENERIC-FUNCTION)| +- |(BOUNDP FUNCTION)| |(BOUNDP LAMBDA-LIST)| ++ DOCUMENTATION |(BOUNDP FUNCTION)| ++ |(BOUNDP GENERIC-FUNCTION)| |(BOUNDP LAMBDA-LIST)| + METHOD-PRETTY-ARGLIST |(BOUNDP SLOT-DEFINITION)| +- |LISP::ARRAY class predicate| + |(BOUNDP CAN-PRECEDE-LIST)| |(BOUNDP PROTOTYPE)| + CLASS-EQ-SPECIALIZER INFORM-TYPE-SYSTEM-ABOUT-CLASS + |PCL::DEFINITION-SOURCE-MIXIN class predicate| +- |(BOUNDP DFUN-STATE)| +- |LISP::STRUCTURE-OBJECT class predicate| +- |(BOUNDP FROM-DEFCLASS-P)| COMPILE |(READER METHOD)| +- |LISP::STANDARD-OBJECT class predicate| ++ |(BOUNDP DFUN-STATE)| |(BOUNDP FROM-DEFCLASS-P)| ++ |(READER METHOD)| + |(CALL STANDARD-COMPUTE-EFFECTIVE-METHOD)| +- |(BOUNDP FAST-FUNCTION)| +- |LISP::COMPLEX class predicate| |(BOUNDP METHOD-CLASS)| +- |(READER SOURCE)| |(BOUNDP METHOD-COMBINATION)| ++ |(BOUNDP FAST-FUNCTION)| |(BOUNDP METHOD-CLASS)| ++ |(READER SOURCE)| |(BOUNDP INTERNAL-WRITER-FUNCTION)| + |(BOUNDP INTERNAL-READER-FUNCTION)| +- |(BOUNDP INTERNAL-WRITER-FUNCTION)| +- ACCESSOR-METHOD-CLASS |(BOUNDP DIRECT-METHODS)| +- |(BOUNDP DIRECT-SLOTS)| |(BOUNDP BOUNDP-FUNCTION)| +- |(BOUNDP DIRECT-SUPERCLASSES)| +- |(BOUNDP DIRECT-SUBCLASSES)| |(BOUNDP OPTIONS)| +- |(BOUNDP METHODS)| |(WRITER METHOD)| +- |LISP::BUILT-IN-CLASS class predicate| ++ |(BOUNDP METHOD-COMBINATION)| ACCESSOR-METHOD-CLASS ++ |(BOUNDP DIRECT-SLOTS)| |(BOUNDP DIRECT-METHODS)| ++ |(BOUNDP BOUNDP-FUNCTION)| |(BOUNDP DIRECT-SUBCLASSES)| ++ |(BOUNDP DIRECT-SUPERCLASSES)| |(BOUNDP METHODS)| ++ |(BOUNDP OPTIONS)| |(WRITER METHOD)| + |PCL::DEPENDENT-UPDATE-MIXIN class predicate| + GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)| ++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| + |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| + |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| +- |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| +- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++ |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| + |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| + |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| + |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| +- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| +- |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| + MAKE-BOUNDP-METHOD-FUNCTION +- |LISP::STRING class predicate| + |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| + |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| + |PCL::METAOBJECT class predicate| +- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| +- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++ |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++ |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++ |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++ |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| + |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| + |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++ |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| + |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| + |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++ |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| + |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| + |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| +- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| + |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +- |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +- |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +- |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| + |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +- |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| +- |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +- |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +- |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +- |(FAST-METHOD MAKE-INSTANCE (CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +- |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| + |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +- |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +- |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++ |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| + |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++ |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| + |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +- |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++ |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++ |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++ |(FAST-METHOD MAKE-INSTANCE (CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++ |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++ |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| + CLASS-PREDICATE-NAME +- |PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION class predicate| +- |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| + |PCL::STRUCTURE-SLOT-DEFINITION class predicate| +- |PCL::STRUCTURE-OBJECT class predicate| +- |LISP::SYMBOL class predicate| ++ |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| ++ |PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION class predicate| + |PCL::EFFECTIVE-SLOT-DEFINITION class predicate| + |(COMBINED-METHOD SHARED-INITIALIZE)| + LEGAL-QUALIFIERS-P ADD-BOUNDP-METHOD +- LEGAL-LAMBDA-LIST-P |LISP::VECTOR class predicate| +- |SETF PCL GENERIC-FUNCTION-NAME| ++ LEGAL-LAMBDA-LIST-P |SETF PCL GENERIC-FUNCTION-NAME| + |(READER READER-FUNCTION)| |(READER PREDICATE-NAME)| +- |(READER READERS)| DESCRIBE-OBJECT +- |(READER CLASS-PRECEDENCE-LIST)| +- |(READER ACCESSOR-FLAGS)| |(READER DOCUMENTATION)| +- |(READER LOCATION)| CLASS-INITIALIZE-INFO ++ |(READER READERS)| |(READER CLASS-PRECEDENCE-LIST)| ++ |(READER ACCESSOR-FLAGS)| |(READER LOCATION)| ++ |(READER DOCUMENTATION)| CLASS-INITIALIZE-INFO + |(SETF CLASS-SLOT-VALUE)| MAKE-WRITER-METHOD-FUNCTION + |SETF PCL GF-DFUN-STATE| + |(READER INCOMPATIBLE-SUPERCLASS-LIST)| +@@ -942,75 +1199,75 @@ + |(READER IDENTITY-WITH-ONE-ARGUMENT)| + |(SETF CLASS-INITIALIZE-INFO)| + |(READER PRETTY-ARGLIST)| |(READER DEFSTRUCT-FORM)| +- |SETF PCL CLASS-NAME| |SETF PCL SLOT-DEFINITION-NAME| ++ |SETF PCL SLOT-DEFINITION-NAME| + |(WRITER READER-FUNCTION)| + |(SETF CLASS-DEFSTRUCT-CONSTRUCTOR)| + |(WRITER PREDICATE-NAME)| |(WRITER READERS)| +- |(READER INITFUNCTION)| |(READER WRITER-FUNCTION)| ++ |(READER WRITER-FUNCTION)| |(READER INITFUNCTION)| + INITIALIZE-INTERNAL-SLOT-FUNCTIONS +- |SETF PCL SLOT-DEFINITION-TYPE| +- |(WRITER CLASS-PRECEDENCE-LIST)| |(READER WRITERS)| ++ |SETF PCL SLOT-DEFINITION-TYPE| |(READER WRITERS)| ++ |(WRITER CLASS-PRECEDENCE-LIST)| + |(WRITER ACCESSOR-FLAGS)| |(READER INITFORM)| +- METHOD-COMBINATION-P |(WRITER DOCUMENTATION)| +- |(WRITER LOCATION)| ++ METHOD-COMBINATION-P |(WRITER LOCATION)| ++ |(WRITER DOCUMENTATION)| + |(CALL REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION)| +- |SETF PCL METHOD-GENERIC-FUNCTION| +- |SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION| + |SETF PCL GENERIC-FUNCTION-METHODS| +- |(READER SLOT-NAME)| ++ |SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION| ++ |SETF PCL METHOD-GENERIC-FUNCTION| |(READER SLOT-NAME)| + |(WRITER INCOMPATIBLE-SUPERCLASS-LIST)| + |SETF PCL SLOT-ACCESSOR-STD-P| + |(CALL REAL-MAKE-METHOD-INITARGS-FORM)| + |(READER ALLOCATION)| |(WRITER SPECIALIZERS)| + |(CALL REAL-ENSURE-GF-USING-CLASS--NULL)| + |(WRITER IDENTITY-WITH-ONE-ARGUMENT)| +- |(SETF METHOD-GENERIC-FUNCTION)| LEGAL-SPECIALIZERS-P +- |(WRITER PRETTY-ARGLIST)| |SETF PCL OBJECT-PLIST| +- |LISP::FLOAT class predicate| |(WRITER DEFSTRUCT-FORM)| +- |(READER GENERIC-FUNCTION)| |(READER FUNCTION)| ++ |(SETF METHOD-GENERIC-FUNCTION)| ++ |(WRITER PRETTY-ARGLIST)| LEGAL-SPECIALIZERS-P ++ |SETF PCL OBJECT-PLIST| |(WRITER DEFSTRUCT-FORM)| ++ |(READER FUNCTION)| |(READER GENERIC-FUNCTION)| + |(READER LAMBDA-LIST)| |(READER SLOT-DEFINITION)| + |PCL::CLASS-PROTOTYPE-SPECIALIZER class predicate| +- |SETF PCL CLASS-DEFSTRUCT-FORM| + |SETF PCL SLOT-DEFINITION-INITFORM| ++ |SETF PCL CLASS-DEFSTRUCT-FORM| + |(READER CAN-PRECEDE-LIST)| + |SETF PCL GENERIC-FUNCTION-METHOD-CLASS| +- |(READER PROTOTYPE)| |(WRITER INITFUNCTION)| +- |(WRITER WRITER-FUNCTION)| |(WRITER WRITERS)| ++ |(READER PROTOTYPE)| |(WRITER WRITER-FUNCTION)| ++ |(WRITER INITFUNCTION)| |(WRITER WRITERS)| + SLOT-ACCESSOR-STD-P |(WRITER INITFORM)| + |(READER DFUN-STATE)| |(READER FROM-DEFCLASS-P)| + |SETF PCL GF-PRETTY-ARGLIST| +- |SETF PCL SLOT-DEFINITION-INITFUNCTION| +- |SETF PCL SLOT-DEFINITION-ALLOCATION| +- |SETF PCL SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION| +- |SETF PCL SLOT-DEFINITION-INTERNAL-READER-FUNCTION| +- |SETF PCL SLOT-DEFINITION-BOUNDP-FUNCTION| +- |SETF PCL SLOT-DEFINITION-WRITER-FUNCTION| +- |SETF PCL SLOT-DEFINITION-READER-FUNCTION| ++ |SETF PCL SLOT-ACCESSOR-FUNCTION| + |SETF PCL SLOT-DEFINITION-LOCATION| +- |SETF PCL SLOT-ACCESSOR-FUNCTION| |(WRITER SLOT-NAME)| +- |(BOUNDP NAME)| |(WRITER ALLOCATION)| +- |(READER FAST-FUNCTION)| |(READER METHOD-CLASS)| +- |(SETF OBJECT-PLIST)| |(READER METHOD-COMBINATION)| +- |(READER INTERNAL-READER-FUNCTION)| ++ |SETF PCL SLOT-DEFINITION-READER-FUNCTION| ++ |SETF PCL SLOT-DEFINITION-WRITER-FUNCTION| ++ |SETF PCL SLOT-DEFINITION-BOUNDP-FUNCTION| ++ |SETF PCL SLOT-DEFINITION-INTERNAL-READER-FUNCTION| ++ |SETF PCL SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION| ++ |SETF PCL SLOT-DEFINITION-ALLOCATION| ++ |SETF PCL SLOT-DEFINITION-INITFUNCTION| ++ |(WRITER SLOT-NAME)| |(BOUNDP NAME)| ++ |(READER FAST-FUNCTION)| |(WRITER ALLOCATION)| ++ |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)| + |(READER INTERNAL-WRITER-FUNCTION)| +- METHOD-COMBINATION-OPTIONS |(READER DIRECT-METHODS)| +- |(READER DIRECT-SLOTS)| +- |SETF PCL SLOT-DEFINITION-READERS| +- |(READER BOUNDP-FUNCTION)| |(WRITER GENERIC-FUNCTION)| +- |(WRITER FUNCTION)| |(READER DIRECT-SUPERCLASSES)| +- |(READER DIRECT-SUBCLASSES)| |SETF PCL DOCUMENTATION| +- |(WRITER LAMBDA-LIST)| |LISP::LIST class predicate| +- FUNCALLABLE-STANDARD-CLASS-P |(BOUNDP CLASS)| ++ |(READER INTERNAL-READER-FUNCTION)| ++ |(READER METHOD-COMBINATION)| ++ METHOD-COMBINATION-OPTIONS |(READER DIRECT-SLOTS)| ++ |(READER DIRECT-METHODS)| ++ |SETF PCL SLOT-DEFINITION-READERS| |(WRITER FUNCTION)| ++ |(WRITER GENERIC-FUNCTION)| |(READER BOUNDP-FUNCTION)| ++ |SETF PCL DOCUMENTATION| |(READER DIRECT-SUBCLASSES)| ++ |(READER DIRECT-SUPERCLASSES)| |(WRITER LAMBDA-LIST)| ++ FUNCALLABLE-STANDARD-CLASS-P + |(FAST-WRITER-METHOD SLOT-OBJECT METHOD)| +- |(WRITER SLOT-DEFINITION)| |(READER OPTIONS)| +- |(READER METHODS)| |(WRITER CAN-PRECEDE-LIST)| +- |SETF PCL SLOT-VALUE-USING-CLASS| ++ |(BOUNDP CLASS)| |(WRITER SLOT-DEFINITION)| ++ |(READER METHODS)| |(READER OPTIONS)| ++ |(WRITER CAN-PRECEDE-LIST)| + |SETF PCL SLOT-DEFINITION-CLASS| +- |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| ++ |SETF PCL SLOT-VALUE-USING-CLASS| + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| +- |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)| +- CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-SLOTS| +- |SETF PCL CLASS-DIRECT-SLOTS| SLOT-ACCESSOR-FUNCTION ++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| ++ |(WRITER PROTOTYPE)| |(BOUNDP TYPE)| |(BOUNDP OBJECT)| ++ CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS| ++ |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION + |(BOUNDP PLIST)| + |SETF PCL CLASS-INCOMPATIBLE-SUPERCLASS-LIST| + |SETF PCL SLOT-DEFINITION-WRITERS| +@@ -1018,290 +1275,287 @@ + |(WRITER DFUN-STATE)| |(WRITER FROM-DEFCLASS-P)| + |(BOUNDP SLOTS)| SLOT-CLASS-P + MAKE-READER-METHOD-FUNCTION LEGAL-METHOD-FUNCTION-P +- |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| +- |(FAST-WRITER-METHOD SLOT-CLASS INITIALIZE-INFO)| + |(FAST-WRITER-METHOD SLOT-OBJECT INITIALIZE-INFO)| ++ |(FAST-WRITER-METHOD SLOT-CLASS INITIALIZE-INFO)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| + |PCL::PLIST-MIXIN class predicate| + |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| +- |(WRITER METHOD-COMBINATION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| GET-METHOD ++ |(WRITER INTERNAL-WRITER-FUNCTION)| + |(WRITER INTERNAL-READER-FUNCTION)| +- |(WRITER INTERNAL-WRITER-FUNCTION)| GET-METHOD +- |(WRITER DIRECT-METHODS)| |(WRITER DIRECT-SLOTS)| +- |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| ++ |(WRITER METHOD-COMBINATION)| |(WRITER DIRECT-SLOTS)| ++ |(WRITER DIRECT-METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)| +- |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)| +- |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)| +- |(WRITER BOUNDP-FUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)| ++ |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)| ++ |(WRITER BOUNDP-FUNCTION)| |(WRITER DIRECT-SUBCLASSES)| + |(WRITER DIRECT-SUPERCLASSES)| +- |(WRITER DIRECT-SUBCLASSES)| + |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| +- |(WRITER OPTIONS)| |(WRITER METHODS)| ++ |(WRITER METHODS)| |(WRITER OPTIONS)| + SHORT-METHOD-COMBINATION-P GF-ARG-INFO + SPECIALIZER-METHOD-TABLE MAKE-METHOD-INITARGS-FORM + CLASS-DEFSTRUCT-FORM +- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION NAME)| +- |(FAST-READER-METHOD SLOT-OBJECT NAME)| +- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)| +- |(FAST-READER-METHOD SLOT-OBJECT DFUN-STATE)| +- |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-NAME)| +- |(FAST-READER-METHOD SLOT-OBJECT SLOT-NAME)| +- |(FAST-READER-METHOD SLOT-DEFINITION NAME)| +- |(FAST-READER-METHOD CLASS NAME)| +- |(FAST-READER-METHOD CLASS PREDICATE-NAME)| + |(FAST-READER-METHOD SLOT-OBJECT PREDICATE-NAME)| +- |LISP::INTEGER class predicate| GF-PRETTY-ARGLIST +- SAME-SPECIALIZER-P +- SLOT-DEFINITION-INTERNAL-READER-FUNCTION +- SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION +- SLOT-DEFINITION-READER-FUNCTION +- SLOT-DEFINITION-WRITER-FUNCTION ++ |(FAST-READER-METHOD CLASS PREDICATE-NAME)| ++ |(FAST-READER-METHOD CLASS NAME)| ++ |(FAST-READER-METHOD SLOT-DEFINITION NAME)| ++ |(FAST-READER-METHOD SLOT-OBJECT SLOT-NAME)| ++ |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-NAME)| ++ |(FAST-READER-METHOD SLOT-OBJECT DFUN-STATE)| ++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)| ++ |(FAST-READER-METHOD SLOT-OBJECT NAME)| ++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION NAME)| ++ GF-PRETTY-ARGLIST SAME-SPECIALIZER-P + SLOT-DEFINITION-BOUNDP-FUNCTION +- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)| +- |(FAST-READER-METHOD SLOT-OBJECT METHOD-CLASS)| +- |(FAST-READER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| +- |(FAST-READER-METHOD SLOT-DEFINITION CLASS)| +- |(FAST-READER-METHOD SLOT-OBJECT CLASS)| +- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION DOCUMENTATION)| +- |(FAST-READER-METHOD SLOT-OBJECT DOCUMENTATION)| +- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)| +- |(FAST-READER-METHOD SLOT-OBJECT METHOD-COMBINATION)| +- |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-DEFINITION)| +- |(FAST-READER-METHOD SLOT-OBJECT SLOT-DEFINITION)| +- |(FAST-READER-METHOD STANDARD-METHOD GENERIC-FUNCTION)| +- |(FAST-READER-METHOD SLOT-OBJECT GENERIC-FUNCTION)| +- |(FAST-READER-METHOD SLOT-OBJECT FUNCTION)| +- |(FAST-READER-METHOD STANDARD-METHOD FAST-FUNCTION)| +- |(FAST-READER-METHOD SLOT-OBJECT FAST-FUNCTION)| +- |(FAST-READER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)| +- |(FAST-READER-METHOD SLOT-OBJECT LOCATION)| +- |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)| +- |(FAST-READER-METHOD SLOT-OBJECT READER-FUNCTION)| +- |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)| +- |(FAST-READER-METHOD SLOT-OBJECT WRITER-FUNCTION)| +- |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)| +- |(FAST-READER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| +- |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)| +- |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| +- |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)| +- |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| +- |(FAST-READER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)| +- |(FAST-READER-METHOD SLOT-OBJECT ALLOCATION)| +- |(FAST-READER-METHOD SLOT-DEFINITION INITFUNCTION)| +- |(FAST-READER-METHOD SLOT-OBJECT INITFUNCTION)| +- |(FAST-READER-METHOD LONG-METHOD-COMBINATION FUNCTION)| +- |(FAST-READER-METHOD TRACED-METHOD FUNCTION)| ++ SLOT-DEFINITION-WRITER-FUNCTION ++ SLOT-DEFINITION-READER-FUNCTION ++ SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION ++ SLOT-DEFINITION-INTERNAL-READER-FUNCTION ++ |(FAST-READER-METHOD SLOT-OBJECT CLASS)| ++ |(FAST-READER-METHOD SLOT-DEFINITION CLASS)| ++ |(FAST-READER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| ++ |(FAST-READER-METHOD SLOT-OBJECT METHOD-CLASS)| ++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)| + |(FAST-READER-METHOD TRACED-METHOD GENERIC-FUNCTION)| +- |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| +- |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| +- |(FAST-READER-METHOD SLOT-DEFINITION READERS)| +- |(FAST-READER-METHOD SLOT-OBJECT READERS)| +- |(FAST-READER-METHOD SLOT-DEFINITION WRITERS)| ++ |(FAST-READER-METHOD TRACED-METHOD FUNCTION)| ++ |(FAST-READER-METHOD LONG-METHOD-COMBINATION FUNCTION)| ++ |(FAST-READER-METHOD SLOT-OBJECT INITFUNCTION)| ++ |(FAST-READER-METHOD SLOT-DEFINITION INITFUNCTION)| ++ |(FAST-READER-METHOD SLOT-OBJECT ALLOCATION)| ++ |(FAST-READER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)| ++ |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| ++ |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)| ++ |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| ++ |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)| ++ |(FAST-READER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| ++ |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)| ++ |(FAST-READER-METHOD SLOT-OBJECT WRITER-FUNCTION)| ++ |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)| ++ |(FAST-READER-METHOD SLOT-OBJECT READER-FUNCTION)| ++ |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)| ++ |(FAST-READER-METHOD SLOT-OBJECT LOCATION)| ++ |(FAST-READER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)| ++ |(FAST-READER-METHOD SLOT-OBJECT FAST-FUNCTION)| ++ |(FAST-READER-METHOD STANDARD-METHOD FAST-FUNCTION)| ++ |(FAST-READER-METHOD SLOT-OBJECT FUNCTION)| ++ |(FAST-READER-METHOD SLOT-OBJECT GENERIC-FUNCTION)| ++ |(FAST-READER-METHOD STANDARD-METHOD GENERIC-FUNCTION)| ++ |(FAST-READER-METHOD SLOT-OBJECT SLOT-DEFINITION)| ++ |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-DEFINITION)| ++ |(FAST-READER-METHOD SLOT-OBJECT METHOD-COMBINATION)| ++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)| ++ |(FAST-READER-METHOD SLOT-OBJECT DOCUMENTATION)| ++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION DOCUMENTATION)| + |(FAST-READER-METHOD SLOT-OBJECT WRITERS)| +- |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)| +- |(FAST-READER-METHOD SLOT-OBJECT OBJECT)| +- |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)| +- |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)| +- |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| +- |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| +- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| +- |(FAST-READER-METHOD SLOT-OBJECT TYPE)| +- |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| +- |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)| +- |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)| ++ |(FAST-READER-METHOD SLOT-DEFINITION WRITERS)| ++ |(FAST-READER-METHOD SLOT-OBJECT READERS)| ++ |(FAST-READER-METHOD SLOT-DEFINITION READERS)| ++ |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| ++ |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| + |(FAST-READER-METHOD SPECIALIZER TYPE)| +- |(FAST-READER-METHOD SLOT-DEFINITION INITFORM)| +- |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| +- |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| ++ |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)| ++ |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)| ++ |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| ++ |(FAST-READER-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| ++ |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)| ++ |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)| ++ |(FAST-READER-METHOD SLOT-OBJECT OBJECT)| ++ |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)| + |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| +- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)| +- |(FAST-READER-METHOD SLOT-OBJECT PRETTY-ARGLIST)| +- |(FAST-READER-METHOD STANDARD-METHOD LAMBDA-LIST)| +- |(FAST-READER-METHOD SLOT-OBJECT LAMBDA-LIST)| +- |(FAST-READER-METHOD PCL-CLASS CLASS-PRECEDENCE-LIST)| +- |(FAST-READER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| +- |(FAST-READER-METHOD PCL-CLASS CAN-PRECEDE-LIST)| +- |(FAST-READER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| +- |(FAST-READER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)| +- |(FAST-READER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| +- |(FAST-READER-METHOD PLIST-MIXIN PLIST)| ++ |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| ++ |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| ++ |(FAST-READER-METHOD SLOT-DEFINITION INITFORM)| + |(FAST-READER-METHOD SLOT-OBJECT PLIST)| +- |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| +- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)| +- |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)| +- |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| +- |(FAST-READER-METHOD SLOT-OBJECT METHODS)| +- |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)| +- |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)| +- |(FAST-READER-METHOD SLOT-CLASS SLOTS)| +- |(FAST-READER-METHOD SLOT-OBJECT SLOTS)| ++ |(FAST-READER-METHOD PLIST-MIXIN PLIST)| ++ |(FAST-READER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| ++ |(FAST-READER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)| ++ |(FAST-READER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| ++ |(FAST-READER-METHOD PCL-CLASS CAN-PRECEDE-LIST)| ++ |(FAST-READER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| ++ |(FAST-READER-METHOD PCL-CLASS CLASS-PRECEDENCE-LIST)| ++ |(FAST-READER-METHOD SLOT-OBJECT LAMBDA-LIST)| ++ |(FAST-READER-METHOD STANDARD-METHOD LAMBDA-LIST)| ++ |(FAST-READER-METHOD SLOT-OBJECT PRETTY-ARGLIST)| ++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-METHODS)| +- |(FAST-READER-METHOD CLASS DIRECT-SUPERCLASSES)| +- |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| +- |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)| ++ |(FAST-READER-METHOD SLOT-OBJECT SLOTS)| ++ |(FAST-READER-METHOD SLOT-CLASS SLOTS)| ++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++ |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)| ++ |(FAST-READER-METHOD SLOT-OBJECT METHODS)| ++ |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| ++ |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)| ++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)| ++ |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| ++ |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)| ++ |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| ++ |(FAST-READER-METHOD CLASS DIRECT-SUPERCLASSES)| + SLOT-DEFINITION-CLASS EQL-SPECIALIZER-OBJECT + |PCL::DIRECT-SLOT-DEFINITION class predicate| + CLASS-CONSTRUCTORS |(BOUNDP WRAPPER)| SLOTS-TO-INSPECT +- |(FAST-BOUNDP-METHOD SLOT-OBJECT NAME)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT DFUN-STATE)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-NAME)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT PREDICATE-NAME)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-NAME)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DFUN-STATE)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT NAME)| + |(BOUNDP DEFSTRUCT-ACCESSOR-SYMBOL)| + SPECIALIZER-DIRECT-GENERIC-FUNCTIONS + |(BOUNDP CLASS-EQ-SPECIALIZER)| + |(SETF SLOT-DEFINITION-NAME)| ADD-WRITER-METHOD +- |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-CLASS)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT DOCUMENTATION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-COMBINATION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-DEFINITION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT GENERIC-FUNCTION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT FUNCTION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT FAST-FUNCTION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT LOCATION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT READER-FUNCTION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITER-FUNCTION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT ALLOCATION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-CLASS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFUNCTION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT ALLOCATION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITER-FUNCTION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT READER-FUNCTION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT LOCATION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FAST-FUNCTION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FUNCTION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT GENERIC-FUNCTION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-DEFINITION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-COMBINATION)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DOCUMENTATION)| + |(BOUNDP OPERATOR)| |(BOUNDP ARG-INFO)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITERS)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| +- |(SETF SLOT-DEFINITION-CLASS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| + |(SETF SLOT-VALUE-USING-CLASS)| +- |(SETF SLOT-DEFINITION-LOCATION)| +- |(SETF SLOT-DEFINITION-READER-FUNCTION)| +- |(SETF SLOT-DEFINITION-WRITER-FUNCTION)| +- |(SETF SLOT-DEFINITION-BOUNDP-FUNCTION)| +- |(SETF SLOT-DEFINITION-INTERNAL-READER-FUNCTION)| +- |(SETF SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION)| +- |(SETF SLOT-DEFINITION-ALLOCATION)| +- |(SETF SLOT-DEFINITION-INITFUNCTION)| ++ |(SETF SLOT-DEFINITION-CLASS)| + |(SETF SLOT-ACCESSOR-FUNCTION)| ++ |(SETF SLOT-DEFINITION-INITFUNCTION)| ++ |(SETF SLOT-DEFINITION-ALLOCATION)| ++ |(SETF SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION)| ++ |(SETF SLOT-DEFINITION-INTERNAL-READER-FUNCTION)| ++ |(SETF SLOT-DEFINITION-BOUNDP-FUNCTION)| ++ |(SETF SLOT-DEFINITION-WRITER-FUNCTION)| ++ |(SETF SLOT-DEFINITION-READER-FUNCTION)| ++ |(SETF SLOT-DEFINITION-LOCATION)| + |(BOUNDP DEFSTRUCT-CONSTRUCTOR)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT PRETTY-ARGLIST)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT LAMBDA-LIST)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT PLIST)| +- |(SETF SLOT-DEFINITION-READERS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT LAMBDA-LIST)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT PRETTY-ARGLIST)| + |(SETF SLOT-DEFINITION-WRITERS)| ++ |(SETF SLOT-DEFINITION-READERS)| + |(SETF SLOT-DEFINITION-TYPE)| + |(SETF SLOT-DEFINITION-INITFORM)| + |(BOUNDP INITIALIZE-INFO)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| + |(FAST-INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| + |(BOUNDP INITARGS)| LONG-METHOD-COMBINATION-FUNCTION + GENERIC-FUNCTION-P +- |PCL::SLOT-DEFINITION class predicate| +- |LISP::NULL class predicate| |(READER NAME)| +- |(READER CLASS)| |(FAST-METHOD SLOT-MISSING (T T T T))| ++ |PCL::SLOT-DEFINITION class predicate| |(READER NAME)| ++ |(READER CLASS)| |(FAST-METHOD SLOT-UNBOUND (T T T))| + |(FAST-METHOD (SETF DOCUMENTATION) (T T))| +- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +- |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +- |(FAST-METHOD SLOT-UNBOUND (T T T))| +- |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| + |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| + |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++ |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++ |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++ |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++ |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD PRINT-OBJECT (CLASS T))| ++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++ |(FAST-METHOD PRINT-OBJECT (T T))| ++ |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++ |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++ |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++ |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++ |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++ |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++ |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++ |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++ |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| + |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++ |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +- |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| + |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +- |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +- |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +- |(FAST-METHOD DESCRIBE-OBJECT (T T))| +- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| + |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++ |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| + |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (T T))| + |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| + |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| + |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SLOT-MISSING (T T T T))| + |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| +- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +- |(FAST-METHOD PRINT-OBJECT (T T))| +- |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- |(FAST-METHOD PRINT-OBJECT (CLASS T))| +- |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +- |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +- |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +- |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)| ++ LEGAL-SLOT-NAME-P |(READER TYPE)| |(READER OBJECT)| + CLASS-WRAPPER |(READER PLIST)| +- |(FAST-METHOD NO-APPLICABLE-METHOD (T))| +- |(FAST-METHOD DOCUMENTATION (T))| + |(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++ |(FAST-METHOD DOCUMENTATION (T))| ++ |(FAST-METHOD NO-APPLICABLE-METHOD (T))| + |(READER SLOTS)| |(WRITER NAME)| DEFINITION-SOURCE + |PCL::SLOT-OBJECT class predicate| DEFAULT-INITARGS +- |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER OBJECT)| +- |(WRITER TYPE)| ++ |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER TYPE)| ++ |(WRITER OBJECT)| + |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| + |(WRITER PLIST)| |(WRITER SLOTS)| + |PCL::DOCUMENTATION-MIXIN class predicate| +@@ -1309,37 +1563,55 @@ + LEGAL-QUALIFIER-P METHOD-P + |PCL::SPECIALIZER-WITH-OBJECT class predicate| + CLASS-SLOT-CELLS +- |(COMBINED-METHOD REINITIALIZE-INSTANCE)| + |(COMBINED-METHOD INITIALIZE-INSTANCE)| ++ |(COMBINED-METHOD REINITIALIZE-INSTANCE)| + STANDARD-ACCESSOR-METHOD-P |(SETF CLASS-NAME)| +- STANDARD-METHOD-P STANDARD-READER-METHOD-P +- STANDARD-GENERIC-FUNCTION-P |(READER WRAPPER)| ++ STANDARD-GENERIC-FUNCTION-P STANDARD-READER-METHOD-P ++ STANDARD-METHOD-P |(READER WRAPPER)| + |(READER DEFSTRUCT-ACCESSOR-SYMBOL)| + |(READER CLASS-EQ-SPECIALIZER)| +- COMPUTE-DEFAULT-INITARGS + COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS +- |(SETF CLASS-DEFSTRUCT-FORM)| ++ COMPUTE-DEFAULT-INITARGS |(SETF CLASS-DEFSTRUCT-FORM)| + |(CALL REAL-MAKE-METHOD-LAMBDA)| + |(SETF CLASS-INCOMPATIBLE-SUPERCLASS-LIST)| +- |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-DIRECT-SLOTS)| +- |(SETF CLASS-SLOTS)| DO-STANDARD-DEFSETF-1 +- |(READER OPERATOR)| |(CALL REAL-ADD-METHOD)| +- |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-GET-METHOD)| ++ |COMMON-LISP::NULL class predicate| ++ |COMMON-LISP::SYMBOL class predicate| ++ |COMMON-LISP::CHARACTER class predicate| ++ |COMMON-LISP::BIT-VECTOR class predicate| ++ |COMMON-LISP::STRING class predicate| ++ |COMMON-LISP::VECTOR class predicate| ++ |COMMON-LISP::ARRAY class predicate| ++ |COMMON-LISP::CONS class predicate| ++ |COMMON-LISP::LIST class predicate| ++ |COMMON-LISP::SEQUENCE class predicate| ++ |COMMON-LISP::RATIO class predicate| ++ |COMMON-LISP::INTEGER class predicate| ++ |COMMON-LISP::RATIONAL class predicate| ++ |COMMON-LISP::FLOAT class predicate| ++ |COMMON-LISP::COMPLEX class predicate| ++ |COMMON-LISP::NUMBER class predicate| ++ |COMMON-LISP::T class predicate| ++ |COMMON-LISP::STRUCTURE-OBJECT class predicate| ++ |COMMON-LISP::STANDARD-OBJECT class predicate| ++ |COMMON-LISP::BUILT-IN-CLASS class predicate| ++ |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-SLOTS)| ++ |(SETF CLASS-DIRECT-SLOTS)| DO-STANDARD-DEFSETF-1 ++ |(READER OPERATOR)| |(CALL REAL-GET-METHOD)| ++ |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-ADD-METHOD)| + |(READER ARG-INFO)| METHOD-COMBINATION-TYPE + |(READER DEFSTRUCT-CONSTRUCTOR)| + |(INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| + |(READER INITIALIZE-INFO)| |(WRITER WRAPPER)| +- STANDARD-CLASS-P |LISP::NUMBER class predicate| +- LEGAL-SPECIALIZER-P ++ STANDARD-CLASS-P LEGAL-SPECIALIZER-P + |PCL::LONG-METHOD-COMBINATION class predicate| + |(WRITER DEFSTRUCT-ACCESSOR-SYMBOL)| + COMPUTE-SLOT-ACCESSOR-INFO |(READER INITARGS)| + |(WRITER CLASS-EQ-SPECIALIZER)| + STANDARD-BOUNDP-METHOD-P FDEFINE-CAREFULLY + |(SETF DOCUMENTATION)| RAW-INSTANCE-ALLOCATOR +- |SETF PCL CLASS-INITIALIZE-INFO| + |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| +- |(WRITER OPERATOR)| |(WRITER ARG-INFO)| ++ |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)| ++ |(WRITER ARG-INFO)| + COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO + STANDARD-WRITER-METHOD-P + CLASS-INCOMPATIBLE-SUPERCLASS-LIST +@@ -1349,78 +1621,77 @@ + METHOD-COMBINATION-DOCUMENTATION + |SETF PCL SLOT-DEFINITION-INITARGS| + REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD +- |(WRITER INITARGS)| + |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| +- |LISP::CONS class predicate| |(BOUNDP METHOD)| +- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION NAME)| +- |(FAST-WRITER-METHOD SLOT-OBJECT NAME)| +- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)| +- |(FAST-WRITER-METHOD SLOT-OBJECT DFUN-STATE)| +- |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-NAME)| +- |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| +- |(FAST-WRITER-METHOD CLASS NAME)| ++ |(WRITER INITARGS)| |(BOUNDP METHOD)| + |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)| ++ |(FAST-WRITER-METHOD CLASS NAME)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-NAME)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DFUN-STATE)| ++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT NAME)| ++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION NAME)| + |(BOUNDP SOURCE)| |(SETF GF-DFUN-STATE)| + SHORT-COMBINATION-OPERATOR +- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-CLASS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| +- |(FAST-WRITER-METHOD SLOT-DEFINITION CLASS)| + |(FAST-WRITER-METHOD SLOT-OBJECT CLASS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT DOCUMENTATION)| +- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-COMBINATION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-DEFINITION)| +- |(FAST-WRITER-METHOD STANDARD-METHOD GENERIC-FUNCTION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT GENERIC-FUNCTION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT FUNCTION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT FAST-FUNCTION)| +- |(FAST-WRITER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT LOCATION)| +- |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT READER-FUNCTION)| +- |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT WRITER-FUNCTION)| +- |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| +- |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| +- |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| +- |(FAST-WRITER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT ALLOCATION)| +- |(FAST-WRITER-METHOD SLOT-DEFINITION INITFUNCTION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT INITFUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION CLASS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-CLASS)| ++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)| + |(FAST-WRITER-METHOD TRACED-METHOD GENERIC-FUNCTION)| +- |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| +- |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| +- |(FAST-WRITER-METHOD SLOT-DEFINITION WRITERS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT INITFUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITFUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT ALLOCATION)| ++ |(FAST-WRITER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)| ++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)| ++ |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)| ++ |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT WRITER-FUNCTION)| ++ |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT READER-FUNCTION)| ++ |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT LOCATION)| ++ |(FAST-WRITER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT FAST-FUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT FUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT GENERIC-FUNCTION)| ++ |(FAST-WRITER-METHOD STANDARD-METHOD GENERIC-FUNCTION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-DEFINITION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-COMBINATION)| ++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DOCUMENTATION)| + |(FAST-WRITER-METHOD SLOT-OBJECT WRITERS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| +- |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| +- |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)| +- |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION WRITERS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| + REMOVE-NAMED-METHOD +- |(FAST-WRITER-METHOD SLOT-DEFINITION INITFORM)| +- |(FAST-WRITER-METHOD SLOT-OBJECT INITFORM)| +- |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| +- |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)| +- |(FAST-WRITER-METHOD SLOT-OBJECT PRETTY-ARGLIST)| +- |(FAST-WRITER-METHOD SLOT-OBJECT LAMBDA-LIST)| +- |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| +- |(FAST-WRITER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| +- |(FAST-WRITER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)| +- |(FAST-WRITER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| +- |(FAST-WRITER-METHOD PLIST-MIXIN PLIST)| ++ |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT INITFORM)| ++ |(FAST-WRITER-METHOD SLOT-DEFINITION INITFORM)| + |(FAST-WRITER-METHOD SLOT-OBJECT PLIST)| ++ |(FAST-WRITER-METHOD PLIST-MIXIN PLIST)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)| ++ |(FAST-WRITER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT LAMBDA-LIST)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT PRETTY-ARGLIST)| ++ |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)| + LEGAL-DOCUMENTATION-P CLASS-DIRECT-SUPERCLASSES + CLASS-DIRECT-SUBCLASSES CLASS-DIRECT-DEFAULT-INITARGS + SLOT-DEFINITION-READERS SLOT-VALUE-USING-CLASS +- COMPUTE-APPLICABLE-METHODS CLASS-NAME CLASSP +- CLASS-PROTOTYPE READER-METHOD-CLASS REMOVE-METHOD ++ COMPUTE-APPLICABLE-METHODS CLASS-NAME CLASS-PROTOTYPE ++ CLASSP READER-METHOD-CLASS REMOVE-METHOD + SLOT-DEFINITION-INITFORM + UPDATE-INSTANCE-FOR-REDEFINED-CLASS + UPDATE-INSTANCE-FOR-DIFFERENT-CLASS CHANGE-CLASS +@@ -1454,5 +1725,6 @@ + ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD + SLOT-DEFINITION-WRITERS + COMPUTE-APPLICABLE-METHODS-USING-CLASSES +- CLASS-PRECEDENCE-LIST)) ++ CLASS-PRECEDENCE-LIST DISASSEMBLE DESCRIBE-OBJECT ++ COMPILE)) + (SETF (GET V 'SYSTEM::PROCLAIMED-CLOSURE) T)) +--- gcl-2.6.12.orig/unixport/makefile ++++ gcl-2.6.12/unixport/makefile +@@ -69,42 +69,7 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l + [ "$(RL_OBJS)" = "" ] || \ + echo "(AUTOLOAD 'init-readline '|readline|)" >>$@ + +-init_gcl.lsp.tmp: init_gcl.lsp.in +- cp $< $@ +- +-init_pre_gcl.lsp.tmp: init_pre_gcl.lsp.in +- cp $< $@ +- +-init_mod_gcl.lsp.tmp: init_mod_gcl.lsp.in +- cp $< $@ +- +-init_xgcl.lsp.tmp: init_gcl.lsp.tmp +- ln -snf $< $@ +- +-init_pcl_gcl.lsp.tmp: init_pcl_gcl.lsp.in ../cmpnew/gcl_cmpmain.lsp \ +- ../pcl/sys-package.lisp ../clcs/package.lisp \ +- $(shell find ../clcs/ -name "clcs_*.lisp") +- +- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==0) print}' $< >$@ +-# cat ../cmpnew/gcl_cmpmain.lsp >>$@ +- cat ../pcl/sys-package.lisp >>$@ +- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==1) print}' $< >>$@ +- +-init_ansi_gcl.lsp.tmp: init_ansi_gcl.lsp.in ../cmpnew/gcl_cmpmain.lsp \ +- ../pcl/sys-package.lisp ../clcs/package.lisp +- +- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \ +- /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==0) print}' $< >$@ +-# cat ../cmpnew/gcl_cmpmain.lsp >>$@ +- cat ../pcl/sys-package.lisp >>$@ +- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \ +- /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==1) print}' $< >>$@ +- cat ../clcs/package.lisp >>$@ +- awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \ +- /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==2) print}' $< >>$@ +- +- +-init_%.lsp: init_%.lsp.tmp ++sys_init.lsp: sys_init.lsp.in + + cat $< | sed \ + -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `date`#1" \ +@@ -118,14 +83,14 @@ init_%.lsp: init_%.lsp.tmp + -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ + -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@ + +-saved_%:raw_% $(RSYM) init_%.lsp raw_%_map msys \ ++saved_%:raw_% $(RSYM) sys_init.lsp raw_%_map msys \ + $(CMPDIR)/gcl_cmpmain.lsp \ + $(CMPDIR)/gcl_lfun_list.lsp \ + $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ + $(LSPDIR)/gcl_auto_new.lsp + +- cp init_$*.lsp foo +- echo " (in-package \"USER\")(system:save-system \"$@\")" >>foo ++ cp sys_init.lsp foo ++ echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo + ar x lib$*.a $$(ar t lib$*.a |grep ^gcl_) + $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo + # check that saved image can be prelinked +@@ -194,7 +159,7 @@ map_%: + clean: + rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \ + $(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \ +- gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script ++ gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script sys_init.lsp + + .INTERMEDIATE: init_ansi_gcl.lsp.tmp init_gcl.lsp.tmp raw_gcl raw_ansi_gcl + .PRECIOUS: init_pre_gcl.lsp init_gcl.lsp init_ansi_gcl.lsp +--- gcl-2.6.12.orig/unixport/sys_ansi_gcl.c ++++ gcl-2.6.12/unixport/sys_ansi_gcl.c +@@ -7,6 +7,10 @@ void + gcl_init_init() + { + ++ object features; ++ features=find_symbol(make_simple_string("*FEATURES*"),system_package); ++ features->s.s_dbind=make_cons(make_keyword("ANSI-CL"),make_cons(make_keyword("COMMON-LISP"),features->s.s_dbind)); ++ + build_symbol_table(); + + lsp_init("../lsp/gcl_export.lsp"); +@@ -86,7 +90,7 @@ gcl_init_system(object no_init) + ar_check_init(gcl_cmpmain,no_init); + + #ifdef HAVE_XGCL +- lsp_init("../xgcl-2/sysdef.lisp"); ++ lsp_init("../xgcl-2/package.lisp"); + ar_check_init(gcl_Xlib,no_init); + ar_check_init(gcl_Xutil,no_init); + ar_check_init(gcl_X,no_init); +--- gcl-2.6.12.orig/unixport/sys_gcl.c ++++ gcl-2.6.12/unixport/sys_gcl.c +@@ -83,7 +83,7 @@ gcl_init_system(object no_init) { + ar_check_init(gcl_cmpmain,no_init); + + #ifdef HAVE_XGCL +- lsp_init("../xgcl-2/sysdef.lisp"); ++ lsp_init("../xgcl-2/package.lisp"); + ar_check_init(gcl_Xlib,no_init); + ar_check_init(gcl_Xutil,no_init); + ar_check_init(gcl_X,no_init); +--- /dev/null ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -0,0 +1,82 @@ ++(make-package :compiler :use '(:lisp :si)) ++(make-package :sloop :use '(:lisp)) ++(make-package :ansi-loop :use'(:lisp)) ++(make-package :defpackage :use '(:lisp)) ++(make-package :tk :use '(:lisp :sloop)) ++(make-package :fpe :use '(:lisp)) ++(make-package :cltl1-compat) ++ ++(in-package :system) ++(use-package :fpe) ++ ++#+(or pcl ansi-cl)(load "../pcl/package.lisp") ++#+ansi-cl(load "../clcs/package.lisp") ++ ++(init-system) ++(in-package :si) ++(gbc t) ++ ++(unless *link-array* ++ (setq *link-array* (make-array (ash 1 11) :element-type 'character :fill-pointer 0))) ++(use-fast-links t) ++ ++(let* ((x (append (pathname-directory *system-directory*) (list :parent))) ++ (lsp (append x (list "lsp"))) ++ (cmpnew (append x (list "cmpnew"))) ++ (h (append x (list "h"))) ++ (xgcl-2 (append x (list "xgcl-2"))) ++ (pcl (append x (list "pcl"))) ++ (clcs (append x (list "clcs"))) ++ (gtk (append x (list "gcl-tk")))) ++ (dolist (d (list lsp cmpnew #-pre-gcl xgcl-2 #+(or pcl ansi-cl) pcl #+ansi-cl clcs)) ++ (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) ++ (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) ++ (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) ++ (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew)) ++ (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp)) ++ ++ (gbc t)) ++ ++(setf (symbol-function 'clear-compiler-properties) ++ (symbol-function 'compiler::compiler-clear-compiler-properties)) ++ ++(terpri) ++(setq *inhibit-macro-special* t) ++(gbc t) ++(reset-gbc-count) ++ ++(defun top-level nil (gcl-top-level)) ++ ++(set-up-top-level) ++ ++(setq *gcl-extra-version* @LI-EXTVERS@ ++ *gcl-minor-version* @LI-MINVERS@ ++ *gcl-major-version* @LI-MAJVERS@) ++ ++(defvar *system-banner* (default-system-banner)) ++(setq *optimize-maximum-pages* t) ++ ++(fmakunbound 'init-cmp-anon) ++(when (fboundp 'user-init) (user-init)) ++(in-package :compiler) ++(setq *cc* @LI-CC@ ++ *ld* @LI-LD@ ++ *ld-libs* @LI-LD-LIBS@ ++ *opt-three* @LI-OPT-THREE@ ++ *opt-two* @LI-OPT-TWO@ ++ *init-lsp* @LI-INIT-LSP@) ++ ++(import 'si::(clines defentry defcfun object void int double ++ quit bye gbc system commonp ++ *break-on-warnings* ++ make-char char-bits char-font char-bit set-char-bit string-char-p int-char ++ char-font-limit char-bits-limit char-control-bit ++ char-meta-bit char-super-bit char-hyper-bit compiler-let) :cltl1-compat) ++(deftype cltl1-compat::string-char nil 'character) ++(do-symbols (s :cltl1-compat) (export s :cltl1-compat)) ++ ++#-ansi-cl(use-package :cltl1-compat :lisp) ++#-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) ++(export '*load-pathname* :si);For maxima, at least as of 5.34.1 ++ ++#+ansi-cl (use-package :pcl :user) +--- gcl-2.6.12.orig/unixport/sys_pcl_gcl.c ++++ gcl-2.6.12/unixport/sys_pcl_gcl.c +@@ -7,6 +7,10 @@ void + gcl_init_init() + { + ++ object features; ++ features=find_symbol(make_simple_string("*FEATURES*"),system_package); ++ features->s.s_dbind=make_cons(make_keyword("PCL"),features->s.s_dbind); ++ + build_symbol_table(); + + lsp_init("../lsp/gcl_export.lsp"); +@@ -86,7 +90,7 @@ gcl_init_system(object no_init) + ar_check_init(gcl_cmpmain,no_init); + + #ifdef HAVE_XGCL +- lsp_init("../xgcl-2/sysdef.lisp"); ++ lsp_init("../xgcl-2/package.lisp"); + ar_check_init(gcl_Xlib,no_init); + ar_check_init(gcl_Xutil,no_init); + ar_check_init(gcl_X,no_init); +--- gcl-2.6.12.orig/unixport/sys_pre_gcl.c ++++ gcl-2.6.12/unixport/sys_pre_gcl.c +@@ -4,6 +4,10 @@ void + gcl_init_init() + { + ++ object features; ++ features=find_symbol(make_simple_string("*FEATURES*"),system_package); ++ features->s.s_dbind=make_cons(make_keyword("PRE-GCL"),features->s.s_dbind); ++ + build_symbol_table(); + + lsp_init("../lsp/gcl_export.lsp"); +@@ -80,6 +84,7 @@ gcl_init_system(object no_init) + lsp_init("../cmpnew/gcl_cmpvar.lsp"); + lsp_init("../cmpnew/gcl_cmpvs.lsp"); + lsp_init("../cmpnew/gcl_cmpwt.lsp"); ++ lsp_init("../cmpnew/gcl_cmpmain.lsp"); + + + } +--- gcl-2.6.12.orig/xgcl-2/gcl_init_xgcl.lsp ++++ gcl-2.6.12/xgcl-2/gcl_init_xgcl.lsp +@@ -36,8 +36,8 @@ + (progn (allocate 'cons 100) (allocate 'string 40) + (system:init-system) (gbc t) + (si::multiply-bignum-stack 25) +- (or lisp::*link-array* +- (setq lisp::*link-array* ++ (or si::*link-array* ++ (setq si::*link-array* + (make-array 500 :element-type 'fixnum :fill-pointer 0))) + (use-fast-links t) + (setq compiler::*cmpinclude* "") (load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp") +--- gcl-2.6.12.orig/xgcl-2/makefile ++++ gcl-2.6.12/xgcl-2/makefile +@@ -4,10 +4,13 @@ + all: objects #docs + + objects: $(LISP) +- echo '(load "sysdef.lisp")(xlib::compile-xgcl)' | $(LISP) ++ echo '(load "sysdef.lisp")(load "sys-proclaim.lisp")(xlib::compile-xgcl)' | $(LISP) + + saved_xgcl: $(LISP) +- echo '(load "sysdef.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP) ++ echo '(load "sysdef.lisp")(load "sys-proclaim.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP) ++ ++sys-proclaim.lisp: ++ echo '(load "sysdef.lisp")(compiler::emit-fn t)(xlib::compile-xgcl)(compiler::make-all-proclaims "*.fn")' | $(LISP) + + docs: dwdoc/dwdoccontents.html dwdoc.pdf + +@@ -22,7 +25,7 @@ dwdoc.pdf: dwdoc.tex + + clean: + rm -f *.o *.data saved_* cmpinclude.h dwdoc.aux dwdoc.log gmon.out +- rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init* ++ rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init* *fn + + clean-docs: + rm -rf dwdoc dwdoc.pdf +--- /dev/null ++++ gcl-2.6.12/xgcl-2/package.lisp +@@ -0,0 +1 @@ ++(make-package :XLIB :use '(:lisp :system)) +--- /dev/null ++++ gcl-2.6.12/xgcl-2/sys-proclaim.lisp +@@ -0,0 +1,287 @@ ++ ++(COMMON-LISP::IN-PACKAGE "COMMON-LISP-USER") ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ XLIB::WINDOW-UNSET XLIB::WINDOW-GET-GEOMETRY ++ XLIB::WINDOW-SET-INVERT XLIB::WINDOW-FONT-INFO ++ XLIB::GET-ST-POINT XLIB::EDITMENU-YANK ++ XLIB::WINDOW-INIT-MOUSE-POLL XLIB::WINDOW-SET-XOR ++ XLIB::WINDOW-TOP-NEG-Y XLIB::WINDOW-LEFT ++ XLIB::WINDOW-QUERY-POINTER XLIB::TEXTMENU-DRAW ++ XLIB::EDITMENU-CARAT XLIB::EDITMENU-DRAW ++ XLIB::WINDOW-STD-LINE-ATTR XLIB::WINDOW-UNMAP ++ XLIB::WINDOW-QUERY-POINTER-B XLIB::WINDOW-BACKGROUND ++ XLIB::EDITMENU-DELETE XLIB::WINDOW-MOVE XLIB::DOWINDOWCOM ++ XLIB::WINDOW-SYNC XLIB::PICMENU-DRAW XLIB::WINDOW-MAP ++ XLIB::WINDOW-RESET-COLOR XLIB::EDITMENU-KILL ++ XLIB::BARMENU-DRAW XLIB::WINDOW-GET-GEOMETRY-B ++ XLIB::MENU-CLEAR XLIB::WINDOW-RESET XLIB::WINDOW-WFUNCTION ++ XLIB::MENU-DRAW XLIB::WINDOW-FOREGROUND XLIB::WINDOW-CLEAR ++ XLIB::EDITMENU-BACKSPACE XLIB::WINDOW-DRAW-BORDER ++ XLIB::LISP-STRING XLIB::WINDOW-SET-ERASE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ XLIB::OPEN-WINDOW)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ XLIB::WINDOW-GET-ELLIPSE XLIB::EDITMENU-SELECT ++ XLIB::WINDOW-SET-XCOLOR XLIB::TEXTMENU-SELECT ++ XLIB::PICMENU-SELECT XLIB::MAKECONT XLIB::WINDOW-GET-CIRCLE ++ XLIB::MENU XLIB::WINDOW-GET-REGION XLIB::TEXTMENU-SET-TEXT ++ XLIB::MENU-SELECT XLIB::BARMENU-SELECT ++ XLIB::PICMENU-CREATE-FROM-SPEC XLIB::PRINTINDEX ++ XLIB::EDITMENU-EDIT XLIB::MENU-CREATE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ XLIB::BARMENU-UPDATE-VALUE XLIB::WINDOW-FONT-STRING-WIDTH ++ XLIB::MENU-FIND-ITEM-WIDTH XLIB::WINDOW-STRING-WIDTH ++ XLIB::PICMENU-BOX-ITEM XLIB::WINDOW-SET-FOREGROUND ++ XLIB::WINDOW-INVERTAREA XLIB::PICMENU-UNBOX-ITEM ++ XLIB::PICMENU-DRAW-NAMED-BUTTON XLIB::WINDOW-SET-CURSOR ++ XLIB::WINDOW-SET-LINE-WIDTH XLIB::PICMENU-DELETE-NAMED-BUTTON ++ XLIB::EDITMENU-ERASE XLIB::PICMENU-DRAW-BUTTON ++ XLIB::WINDOW-SET-BACKGROUND)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ XLIB::XINIT XLIB::WINDOW-SCREEN-HEIGHT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++ XLIB::WINDOW-CIRCLE-RADIUS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ XLIB::WINDOW-XOR-BOX-XY XLIB::WINDOW-DRAW-BOX-CORNERS ++ XLIB::WINDOW-DRAW-LINE-XY XLIB::WINDOW-DRAW-ARROW2-XY ++ XLIB::WINDOW-DRAW-ARROW-XY XLIB::WINDOW-DRAW-ELLIPSE-XY ++ XLIB::WINDOW-ERASE-BOX-XY XLIB::WINDOW-DRAW-BOX-XY ++ XLIB::WINDOW-DRAW-ARROWHEAD-XY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ XLIB::WINDOW-COPY-AREA-XY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ XLIB::WINDOW-PRETTYPRINTAT XLIB::MENU-UNBOX-ITEM ++ XLIB::WINDOW-PRINTAT XLIB::WINDOW-DRAW-CROSSHAIRS-XY ++ XLIB::WINDOW-MOVETO-XY XLIB::WINDOW-INVERT-AREA ++ XLIB::WINDOW-DRAW-DOT-XY XLIB::WINDOW-DRAW-CARAT ++ XLIB::WINDOW-ERASE-AREA XLIB::MENU-BOX-ITEM ++ XLIB::WINDOW-DRAW-CROSS-XY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ XLIB::WINDOW-DRAW-CIRCLE-XY XLIB::WINDOW-PRINT-LINE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ XLIB::WINDOW-PRETTYPRINTAT-XY XLIB::WINDOW-DRAW-CIRCLE-PT ++ XLIB::EDITMENU-DISPLAY XLIB::WINDOW-PRINTAT-XY ++ XLIB::WINDOW-PROCESS-CHAR-EVENT XLIB::MENU-DISPLAY-ITEM)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ XLIB::WINDOW-ADJ-BOX-XY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ XLIB::WINDOW-DRAW-ARC-XY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ XLIB::WINDOW-DRAW-ELLIPSE-PT XLIB::WINDOW-ERASE-AREA-XY ++ XLIB::WINDOW-INVERT-AREA-XY XLIB::WINDOW-DRAW-VECTOR-PT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ XLIB::WINDOW-DRAW-LINE XLIB::WINDOW-DRAW-BOX ++ XLIB::WINDOW-DRAW-CIRCLE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ XLIB::WINDOW-DRAW-RCBOX-XY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ XLIB::WINDOW-DRAW-LATEX-XY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ XLIB::WINDOW-SET-LINE-ATTR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ XLIB::WINDOW-DRAW-BOX-LINE-XY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ XLIB::WINDOW-POSITIVE-Y XLIB::WINDOW-STRING-EXTENTS ++ XLIB::MENU-CHOOSE XLIB::WINDOW-SET-FONT XLIB::PUSHFONT ++ XLIB::WINDOW-STRING-HEIGHT XLIB::WORDLIST< ++ XLIB::EDITMENU-LINE-Y XLIB::MENU-ITEM-Y ++ XLIB::MENU-FIND-ITEM-HEIGHT XLIB::XFERCHARS ++ XLIB::WINDOW-CENTEROFFSET XLIB::MENU-FIND-ITEM-Y ++ XLIB::EDITMENU-CHAR XLIB::MENU-ITEM-VALUE ++ XLIB::MENU-FIND-ITEM)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ XLIB::WINDOW-FREE-COLOR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ XLIB::SEARCHFORALPHA XLIB::SAFE-CHAR XLIB::WINDOW-XINIT ++ XLIB::WINDOW-MENU XLIB::WINDOW-INIT-KEYMAP XLIB::PARSE-INT ++ XLIB::WINDOW-DESTROY-SELECTED-WINDOW ++ XLIB::WINDOW-GET-MOUSE-POSITION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) ++ XLIB::FLUSHLINE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ XLIB::PICMENU-BUTTON-CONTAINSXY? XLIB::MENU-MOVETO-XY ++ XLIB::WINDOW-GET-BOX-SIZE XLIB::PRINTINDEXN ++ XLIB::WINDOW-GET-LINE-POSITION ++ XLIB::PICMENU-SET-NAMED-BUTTON-COLOR XLIB::EDITMENU-SETXY ++ XLIB::MENU-SELECT-B XLIB::MENU-REPOSITION-LINE ++ XLIB::WINDOW-GET-VECTOR-END)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ XLIB::WINDOW-CREATE XLIB::WINDOW-TRACK-MOUSE ++ XLIB::PICMENU-ITEM-POSITION XLIB::WINDOW-GET-CHARS ++ XLIB::TEXTMENU-CREATE XLIB::EDITMENU-CREATE XLIB::TOHTML ++ XLIB::WINDOW-SET-COLOR XLIB::MENU-ITEM-POSITION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ XLIB::WINDOW-INPUT-STRING XLIB::PICMENU-CREATE-SPEC ++ XLIB::WINDOW-SET-COLOR-RGB XLIB::WINDOW-PRINT-LINES ++ XLIB::PICMENU-CREATE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ XLIB::WINDOW-GET-ICON-POSITION XLIB::BARMENU-CREATE ++ XLIB::WINDOW-GET-LATEX-POSITION XLIB::WINDOW-GET-BOX-POSITION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ XLIB::WINDOW-EDIT XLIB::WINDOW-TRACK-MOUSE-IN-REGION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ XLIB::WINDOW-ADJUST-BOX-SIDE XLIB::EDITMENU-EDIT-FN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ XLIB::WINDOW-GET-BOX-LINE-POSITION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ XLIB::WINDOW-DESTROY XLIB::EDITMENU-CALCULATE-SIZE ++ XLIB::STRINGIFY XLIB::DOLINE XLIB::PUSHENV ++ XLIB::WINDOW-POLL-MOUSE XLIB::WINDOW-FONT XLIB::WINDOW-SIZE ++ XLIB::EDITMENU-END XLIB::WINDOW-PAINT XLIB::WINDOW-GEOMETRY ++ XLIB::MENU-DESTROY XLIB::WINDOW-LABEL ++ XLIB::PICMENU-CALCULATE-SIZE XLIB::POPENV XLIB::WINDOW-PARENT ++ XLIB::WINDOW-WAIT-UNMAP XLIB::EDITMENU-INIT ++ XLIB::WINDOW-GET-POINT XLIB::MENU-SELECT! ++ XLIB::MENU-CALCULATE-SIZE XLIB::BARMENU-INIT XLIB::DOCOMMAND ++ XLIB::MENU-INIT XLIB::WINDOW-OPEN XLIB::EDITMENU-META-B ++ XLIB::WINDOW-GET-RAW-CHAR XLIB::WINDOW-DRAWABLE-HEIGHT ++ XLIB::MENU-REPOSITION XLIB::WINDOW-YPOSITION ++ XLIB::EDITMENU-ALPHANUMBERICP XLIB::EDITMENU-NEXT ++ XLIB::MENU-SIZE XLIB::EDITMENU-PREVIOUS XLIB::EDITMENU-FORWARD ++ XLIB::EDITMENU-BEGINNING XLIB::PICMENU-DESTROY ++ XLIB::WINDOW-RESET-GEOMETRY XLIB::WINDOW-GCONTEXT ++ XLIB::EDITMENU-BACKWARD XLIB::TERMLINE ++ XLIB::WINDOW-DRAWABLE-WIDTH XLIB::WINDOW-GET-CROSSHAIRS ++ XLIB::BARMENU-CALCULATE-SIZE XLIB::WINDOW-CHAR-DECODE ++ XLIB::DOTABULAR XLIB::PICMENU-INIT XLIB::WINDOW-WAIT-EXPOSURE ++ XLIB::PARSE-WORD XLIB::TEXTMENU-INIT XLIB::SEARCHFOR ++ XLIB::MENU-OFFSET XLIB::MENU-ADJUST-OFFSET ++ XLIB::WINDOW-SET-COPY XLIB::TEXTMENU-CALCULATE-SIZE ++ XLIB::WINDOW-GET-CROSS XLIB::EDITMENU-META-F ++ XLIB::WINDOW-GET-CLICK XLIB::EDITMENU-CURRENT-CHAR ++ XLIB::DOHTML XLIB::WINDOW-CLOSE XLIB::EDITMENU-RETURN ++ XLIB::WINDOW-CODE-CHAR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ XLIB::WINDOW-FORCE-OUTPUT)) +\ No newline at end of file +--- gcl-2.6.12.orig/xgcl-2/sysdef.lisp ++++ gcl-2.6.12/xgcl-2/sysdef.lisp +@@ -19,9 +19,8 @@ + ; Some of the files that interface to the Xlib are adapted from DEC/MIT files. + ; See the file dec.copyright for details. + +-(make-package :XLIB) ++(load "package.lisp") + (in-package :XLIB) +-(sys::use-package '(:lisp :system :sys)) + + (defvar *files* '( "gcl_Xlib" + "gcl_Xutil" diff --git a/patches/Version_2_6_13pre12 b/patches/Version_2_6_13pre12 new file mode 100644 index 00000000..8d55df80 --- /dev/null +++ b/patches/Version_2_6_13pre12 @@ -0,0 +1,1168 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-10) unstable; urgency=medium + . + * rebuild in clean sid environment +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/bin/dpp.c ++++ gcl-2.6.12/bin/dpp.c +@@ -430,7 +430,8 @@ put_declaration() + { + int i; + +- fprintf(out, "\tint narg;\n"); ++ if (nopt || rest_flag || key_flag) ++ fprintf(out, "\tint narg;\n"); + fprintf(out, "\tregister object *DPPbase=vs_base;\n"); + + for (i = 0; i < nopt; i++) +@@ -453,12 +454,12 @@ put_declaration() + fprintf(out, "#define\t%s\tDPPbase[%d+%d+2*%d+%d]\n", + aux[i].a_var, nreq, nopt, nkey, i); + fprintf(out, "\n"); +- fprintf(out, "\tnarg = vs_top - vs_base;\n"); + if (nopt == 0 && !rest_flag && !key_flag) + fprintf(out, "\tcheck_arg(%d);\n", nreq); + else { +- fprintf(out, "\tif (narg < %d)\n", nreq); +- fprintf(out, "\t\ttoo_few_arguments();\n"); ++ fprintf(out, "\tnarg = vs_top - vs_base;\n"); ++ fprintf(out, "\tif (narg < %d)\n", nreq); ++ fprintf(out, "\t\ttoo_few_arguments();\n"); + } + for (i = 0; i < nopt; i++) + if (optional[i].o_svar != NULL) { +--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp +@@ -976,9 +976,13 @@ + (wt-nl "}}") + (wt-nl "vs_top=(vs_base=base+" base ")+" (- *vs* base) ";") + (unwind-exit 'fun-val nil (cons 'values 2)))) +- ((unwind-exit (get-inline-loc `((t t) t #.(flags rfa) +- ,(concatenate 'string +- "({struct htent *_z=gethash" +- (if *safe-compile* "_with_check" "") +- "(#0,#1);_z->hte_key==OBJNULL ? (#2) : _z->hte_value;})")) +- args))))) ++ ((let ((*inline-blocks* 0) ++ (*restore-avma* *restore-avma*) ++ (fd `((t t) t #.(flags rfa) ++ ,(concatenate 'string ++ "({struct htent *_z=gethash" ++ (if *safe-compile* "_with_check" "") ++ "(#0,#1);_z->hte_key==OBJNULL ? (#2) : _z->hte_value;})")))) ++ (save-avma fd) ++ (unwind-exit (get-inline-loc fd args)) ++ (close-inline-blocks))))) +--- gcl-2.6.12.orig/cmpnew/gcl_cmptag.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptag.lsp +@@ -62,6 +62,7 @@ + ((and (eq (car clause) 'go) + (tag-p (setq tem (cadddr (cdr clause)))) + (eq (tag-name tem) tag-name))) ++ ((eq (car clause) 'location) nil) + (t (or (jumps-to-p (car clause) tag-name) + (jumps-to-p (cdr clause) tag-name))))) + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4171,18 +4171,52 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu + #fi + # subst GCC not only under 386-linux, but where available -- CM + ++TCFLAGS="-fsigned-char" ++ + if test "$GCC" = "yes" ; then + +- TCFLAGS="-Wall -fsigned-char" ++ TCFLAGS="$TCFLAGS -Wall" + +- #FIXME -Wno-unused-but-set-variable when time +- TMPF=-Wno-unused-but-set-variable +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5 +-$as_echo_n "checking for CFLAG $TMPF... " >&6; } +- CFLAGS_ORI=$CFLAGS +- CFLAGS="$CFLAGS $TMPF" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 ++$as_echo_n "checking for clang... " >&6; } + + if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++ ++ int main() { ++ return ++ #ifdef __clang__ ++ 0 ++ #else ++ 1 ++ #endif ++ ;} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ clang="yes" ++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" ++ ++$as_echo "#define CLANG 1" >>confdefs.h ++ ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } ++ #FIXME -Wno-unused-but-set-variable when time ++ TMPF=-Wno-unused-but-set-variable ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5 ++$as_echo_n "checking for CFLAG $TMPF... " >&6; } ++ CFLAGS_ORI=$CFLAGS ++ CFLAGS="$CFLAGS $TMPF" ++ if test "$cross_compiling" = yes; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + else +@@ -4201,11 +4235,14 @@ rm -f core *.core core.conftest.* gmon.o + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- CFLAGS=$CFLAGS_ORI ++ CFLAGS=$CFLAGS_ORI ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi + +-else +- TCFLAGS="-fsigned-char" + fi ++ + if test "$GCC" = "yes" ; then + TCFLAGS="$TCFLAGS -pipe" + case $use in +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -483,21 +483,37 @@ AC_SUBST(CC) + #fi + # subst GCC not only under 386-linux, but where available -- CM + +-if test "$GCC" = "yes" ; then ++TCFLAGS="-fsigned-char" + +- TCFLAGS="-Wall -fsigned-char" ++if test "$GCC" = "yes" ; then + +- #FIXME -Wno-unused-but-set-variable when time +- TMPF=-Wno-unused-but-set-variable +- AC_MSG_CHECKING([for CFLAG $TMPF]) +- CFLAGS_ORI=$CFLAGS +- CFLAGS="$CFLAGS $TMPF" +- AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no)) +- CFLAGS=$CFLAGS_ORI ++ TCFLAGS="$TCFLAGS -Wall" + +-else +- TCFLAGS="-fsigned-char" ++ AC_MSG_CHECKING([for clang]) ++ AC_RUN_IFELSE([ ++ AC_LANG_SOURCE([[ ++ int main() { ++ return ++ #ifdef __clang__ ++ 0 ++ #else ++ 1 ++ #endif ++ ;}]])], ++ [AC_MSG_RESULT([yes]) ++ clang="yes" ++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" ++ AC_DEFINE([CLANG],[1],[running clang compiler])], ++ [AC_MSG_RESULT([no]) ++ #FIXME -Wno-unused-but-set-variable when time ++ TMPF=-Wno-unused-but-set-variable ++ AC_MSG_CHECKING([for CFLAG $TMPF]) ++ CFLAGS_ORI=$CFLAGS ++ CFLAGS="$CFLAGS $TMPF" ++ AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no)) ++ CFLAGS=$CFLAGS_ORI]) + fi ++ + if test "$GCC" = "yes" ; then + TCFLAGS="$TCFLAGS -pipe" + case $use in +--- gcl-2.6.12.orig/gcl-tk/comm.c ++++ gcl-2.6.12/gcl-tk/comm.c +@@ -183,7 +183,7 @@ int m; + { bcopy(sfd->valid_data,sfd->read_buffer,sfd->valid_data_size); + sfd->valid_data=sfd->read_buffer;} + /* there is at least a packet size of space available */ +- if ((fix(FFN(fScheck_fd_for_input)(sfd->fd,sfd->write_timeout))>0)); ++ if ((fix(FFN(fScheck_fd_for_input)(sfd->fd,sfd->write_timeout))>0)) + again: + {char *start = sfd->valid_data+sfd->valid_data_size; + nread = SAFE_READ(sfd->fd,start, +--- gcl-2.6.12.orig/gcl-tk/guis.c ++++ gcl-2.6.12/gcl-tk/guis.c +@@ -455,7 +455,7 @@ struct connection_state *sfd; + int tot; + struct message_header *msg; + msg = (struct message_header *) buf; +- m= read1(sfd,msg,MESSAGE_HEADER_SIZE,DEFAULT_TIMEOUT_FOR_TK_READ); ++ m= read1(sfd,(void *)msg,MESSAGE_HEADER_SIZE,DEFAULT_TIMEOUT_FOR_TK_READ); + if (m == MESSAGE_HEADER_SIZE) + { + if ( msg->magic1!=MAGIC1 +@@ -468,7 +468,7 @@ struct connection_state *sfd; + if (tot >= bufleng) + {msg = (void *)malloc(tot+1); + bcopy(buf,msg,MESSAGE_HEADER_SIZE);} +- m = read1(sfd,&(msg->body), ++ m = read1(sfd,(void *)&(msg->body), + body_length,DEFAULT_TIMEOUT_FOR_TK_READ); + if (m == body_length) + { return msg;}} +--- gcl-2.6.12.orig/h/compbas.h ++++ gcl-2.6.12/h/compbas.h +@@ -4,7 +4,7 @@ + #define EXTER extern + #endif + #ifndef INLINE +-#if defined(__GNUC__) && __GNUC__ <= 4 ++#if (defined(__GNUC__) && __GNUC__ <= 4) && !defined __clang__ + #define INLINE extern inline + #else + #define INLINE inline +--- gcl-2.6.12.orig/h/fixnum.h ++++ gcl-2.6.12/h/fixnum.h +@@ -13,7 +13,7 @@ + #define is_imm_fix(a_) INT_IN_BITS(a_,LOW_SHFT-1) + #elif defined (IM_FIX_BASE) && defined(IM_FIX_LIM) + #define make_imm_fixnum(a_) ((object)((a_)+(IM_FIX_BASE+(IM_FIX_LIM>>1)))) +-#define fix_imm_fixnum(a_) (((fixnum)(a_))-(IM_FIX_BASE+(IM_FIX_LIM>>1))) ++#define fix_imm_fixnum(a_) ((fixnum)(((fixnum)(a_))-(IM_FIX_BASE+(IM_FIX_LIM>>1)))) + #define mark_imm_fixnum(a_) ((a_)=((object)(((fixnum)(a_)) | IM_FIX_LIM))) + #define unmark_imm_fixnum(a_) ((a_)=((object)(((fixnum)(a_)) &~ IM_FIX_LIM))) + #define is_imm_fixnum(a_) (((ufixnum)(a_))>=IM_FIX_BASE) +--- gcl-2.6.12.orig/h/gclincl.h.in ++++ gcl-2.6.12/h/gclincl.h.in +@@ -9,9 +9,6 @@ + /* punt guess for no randomize value */ + #undef ADDR_NO_RANDOMIZE + +-/* compile ansi compliant image */ +-#undef ANSI_COMMON_LISP +- + /* binding stack size */ + #undef BDSSIZE + +@@ -21,6 +18,9 @@ + /* can prevent sbrk from returning random values */ + #undef CAN_UNRANDOMIZE_SBRK + ++/* running clang compiler */ ++#undef CLANG ++ + /* Define to one of `_getb67', `GETB67', `getb67' for Cray-2 and Cray-YMP + systems. This function is required for `alloca.c' support on those systems. + */ +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -342,7 +342,8 @@ EXTER long holepage; /* hole pages * + EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult; + + +-EXTER char *rb_start; /* relblock start */ ++EXTER char *new_rb_start; /* desired relblock start after next gc */ ++EXTER char *rb_start; /* relblock start */ + EXTER char *rb_end; /* relblock end */ + EXTER char *rb_limit; /* relblock limit */ + EXTER char *rb_pointer; /* relblock pointer */ +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1946,3 +1946,12 @@ get_pageinfo(void *); + + void + add_page_to_freelist(char *, struct typemanager *); ++ ++ufixnum ++sum_maxpages(void); ++ ++void ++resize_hole(ufixnum,enum type); ++ ++void ++setup_rb(void); +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -325,14 +325,29 @@ empty_relblock(void) { + + } + +-static inline void ++void ++setup_rb(void) { ++ ++ int init=new_rb_start!=rb_start || rb_pointer>=rb_end; ++ ++ rb_start=new_rb_start; ++ rb_end=rb_start+(nrbpage<>PAGEWIDTH))); ++ ++} ++ ++void + resize_hole(ufixnum hp,enum type tp) { + +- char *new_start=heap_end+hp*PAGESIZE; + char *start=rb_pointer=start) || (new_start=start+size)) { ++ new_rb_start=heap_end+hp*PAGESIZE; ++ ++ if ((new_rb_start=start) || (new_rb_start=start+size)) { + fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp); + fflush(stderr); + tm_table[t_relocatable].tm_adjgbccnt--; +@@ -340,9 +355,11 @@ resize_hole(ufixnum hp,enum type tp) { + return resize_hole(hp,tp); + } + +- holepage=hp; +- tm_of(tp)->tm_adjgbccnt--; +- GBC(tp); ++ if (size) { ++ tm_of(tp)->tm_adjgbccnt--; ++ GBC(tp); ++ } else ++ setup_rb(); + + } + +@@ -355,7 +372,7 @@ alloc_page(long n) { + + if (!s) { + +- if (nn>holepage) { ++ if (nn>((rb_start-heap_end)>>PAGEWIDTH)) { + + + fixnum d=available_pages-nn; +@@ -373,12 +390,11 @@ alloc_page(long n) { + e=heap_end; + v=e+nn*PAGESIZE; + +- if (!s) { ++ if (!s) + +- holepage -= nn; + heap_end=v; + +- } else if (v>(void *)core_end) { ++ else if (v>(void *)core_end) { + + massert(!mbrk(v)); + core_end=v; +@@ -395,7 +411,7 @@ alloc_page(long n) { + + struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;; + +-static inline ufixnum ++ufixnum + sum_maxpages(void) { + + ufixnum i,j; +@@ -516,7 +532,7 @@ rebalance_maxpages(struct typemanager *m + k+=(tm_table[i].tm_maxpage-tm_table[i].tm_npage)*(i==t_relocatable ? 2 : 1); + + e=e>k ? k : e; +- if (e+phys_pages-j<=0) ++ if (e+phys_pages<=j) + return 0; + + f=k ? 1.0-(double)e/k : 1.0; +@@ -895,17 +911,20 @@ add_pages(struct typemanager *tm,fixnum + + case t_relocatable: + +- if (rb_pointer>rb_end) { ++ if (rb_pointer>rb_end && m>((rb_start-heap_end)>>PAGEWIDTH)) { + fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); + fflush(stderr); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + nrbpage+=m; +- rb_end+=m*PAGESIZE; + rb_limit+=m*PAGESIZE; ++ if (rb_pointer>rb_end) ++ rb_start-=m*PAGESIZE; ++ else ++ rb_end+=m*PAGESIZE; + +- alloc_page(-(2*nrbpage+holepage)); ++ alloc_page(-(2*nrbpage+((rb_start-heap_end)>>PAGEWIDTH))); + + break; + +@@ -1116,7 +1135,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate + { struct typemanager *tm=(&tm_table[t_from_type(typ)]); + tm = & tm_table[tm->tm_type]; + if (tm->tm_type == t_relocatable) +- { tm->tm_npage = (rb_end-rb_start)/PAGESIZE; ++ { tm->tm_npage = (rb_end-rb_start)>>PAGEWIDTH; + tm->tm_nfree = rb_limit -rb_pointer; + } + else if (tm->tm_type == t_contiguous) +@@ -1242,11 +1261,8 @@ object malloc_list=Cnil; + + void + maybe_set_hole_from_maxpages(void) { +- if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) { +- holepage=new_holepage; +- alloc_page(-holepage); +- rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<= (void*)baby_malloc_data && ptr - (void*)baby_malloc_data st.st_fillp = size; + return(ptr); + } else { +- j = x->st.st_dim; + x->st.st_self = alloc_contblock(size); + x->st.st_fillp = x->st.st_dim = size; + for (i = 0; i < size; i++) + x->st.st_self[i] = ((char *)ptr)[i]; +-/* SGC contblock pages: Its possible this is on an old page CM 20030827 */ +-/* #ifdef SGC */ +-/* insert_maybe_sgc_contblock(ptr, j); */ +-/* #else */ +-/* insert_contblock(ptr, j); */ +-/* #endif */ + return(x->st.st_self); + } + } +--- gcl-2.6.12.orig/o/assignment.c ++++ gcl-2.6.12/o/assignment.c +@@ -259,7 +259,7 @@ DEFUNO_NEW("FMAKUNBOUND",object,fLfmakun + static void + FFN(Fsetf)(object form) + { +- object result,*t,*t1; ++ object *t,*t1; + if (endp(form)) { + vs_base = vs_top; + vs_push(Cnil); +@@ -269,7 +269,7 @@ FFN(Fsetf)(object form) + vs_top = top; + if (endp(MMcdr(form))) + FEinvalid_form("No value for ~S.", form->c.c_car); +- result = setf(MMcar(form), MMcadr(form)); ++ setf(MMcar(form), MMcadr(form)); + form = MMcddr(form); + } while (!endp(form)); + t=vs_base; +--- gcl-2.6.12.orig/o/cfun.c ++++ gcl-2.6.12/o/cfun.c +@@ -343,7 +343,8 @@ turbo_closure(object fun) + + if(1)/*(fun->cc.cc_turbo==NULL)*/ + {BEGIN_NO_INTERRUPT; +- for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr); ++ for (n = 0, l = fun->cc.cc_env; !endp(l); n++, l = l->c.c_cdr) ++ ; + { + block= AR_ALLOC(alloc_relblock,(1+n),object); + *block=make_fixnum(n); +--- gcl-2.6.12.orig/o/format.c ++++ gcl-2.6.12/o/format.c +@@ -170,6 +170,22 @@ object sSAindent_formatted_outputA; + fmt_string = old_fmt_string ; \ + fmt_paramp = old_fmt_paramp + ++#define fmt_old1 VOL object old_fmt_stream; \ ++ VOL int old_ctl_origin; \ ++ VOL int old_ctl_index; \ ++ VOL int old_ctl_end; \ ++ jmp_bufp VOL old_fmt_jmp_bufp; \ ++ VOL int old_fmt_indents; \ ++ VOL object old_fmt_string ; \ ++ VOL format_parameter *old_fmt_paramp ++#define fmt_save1 old_fmt_stream = fmt_stream; \ ++ old_ctl_origin = ctl_origin; \ ++ old_ctl_index = ctl_index; \ ++ old_ctl_end = ctl_end; \ ++ old_fmt_jmp_bufp = fmt_jmp_bufp; \ ++ old_fmt_indents = fmt_indents; \ ++ old_fmt_string = fmt_string ; \ ++ old_fmt_paramp = fmt_paramp + #define fmt_restore1 fmt_stream = old_fmt_stream; \ + ctl_origin = old_ctl_origin; \ + ctl_index = old_ctl_index; \ +@@ -1776,7 +1792,7 @@ fmt_case(bool colon, bool atsign) + { + VOL object x; + VOL int i, j; +- fmt_old; ++ fmt_old1; + jmp_buf fmt_jmp_buf0; + int up_colon; + bool b; +@@ -1787,7 +1803,7 @@ fmt_case(bool colon, bool atsign) + j = fmt_skip(); + if (ctl_string[--j] != ')' || ctl_string[--j] != '~') + fmt_error("~) expected"); +- fmt_save; ++ fmt_save1; + fmt_jmp_bufp = &fmt_jmp_buf0; + if ((up_colon = setjmp(*fmt_jmp_bufp))) + ; +@@ -1850,7 +1866,7 @@ fmt_conditional(bool colon, bool atsign) + object x; + int n=0; + bool done; +- fmt_old; ++ fmt_old1; + + fmt_not_colon_atsign(colon, atsign); + if (colon) { +@@ -1863,11 +1879,11 @@ fmt_conditional(bool colon, bool atsign) + if (ctl_string[--k] != ']' || ctl_string[--k] != '~') + fmt_error("~] expected"); + if (fmt_advance() == Cnil) { +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + i, j - i); + fmt_restore1; + } else { +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + j + 2, k - (j + 2)); + fmt_restore1; + } +@@ -1880,7 +1896,7 @@ fmt_conditional(bool colon, bool atsign) + ; + else { + --fmt_index; +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + i, j - i); + fmt_restore1; + } +@@ -1899,7 +1915,7 @@ fmt_conditional(bool colon, bool atsign) + for (k = j; ctl_string[--k] != '~';) + ; + if (n == 0) { +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + i, k - i); + fmt_restore1; + done = TRUE; +@@ -1925,7 +1941,7 @@ fmt_conditional(bool colon, bool atsign) + if (ctl_string[--j] != ']' || ctl_string[--j] != '~') + fmt_error("~] expected"); + if (!done) { +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + i, j - i); + fmt_restore1; + } +@@ -2062,7 +2078,7 @@ fmt_justification(volatile bool colon, b + { + int mincol=0, colinc=0, minpad=0, padchar=0; + object fields[FORMAT_DIRECTIVE_LIMIT]; +- fmt_old; ++ fmt_old1; + jmp_buf fmt_jmp_buf0; + VOL int i,j,n,j0; + int k,l,m,l0; +@@ -2089,7 +2105,7 @@ fmt_justification(volatile bool colon, b + ; + fields[n] = make_string_output_stream(64); + vs_push(fields[n]); +- fmt_save; ++ fmt_save1; + fmt_jmp_bufp = &fmt_jmp_buf0; + if ((up_colon = setjmp(*fmt_jmp_bufp))) { + --n; +@@ -2116,7 +2132,7 @@ fmt_justification(volatile bool colon, b + special = 1; + for (j = j0; ctl_string[j] != '~'; --j) + ; +- fmt_save; ++ fmt_save1; + format(fmt_stream, ctl_origin + j, j0 - j + 2); + fmt_restore1; + spare_spaces = fmt_spare_spaces; +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -24,7 +24,7 @@ + IMPLEMENTATION-DEPENDENT + */ + +-/* #define DEBUG */ ++#define DEBUG + + #define IN_GBC + #define NEED_MP_H +@@ -149,15 +149,6 @@ pageinfo_p(void *v) { + + } + +-static inline bool +-in_contblock_stack_list(void *p,void ***ap) { +- void **a; +- for (a=*ap;a && a[0]>p;a=a[1]); +- *ap=a; +- /* if (a && a[0]==p) fprintf(stderr,"Skipping %p\n",p); */ +- return a && a[0]==p; +-} +- + static inline char + get_bit(char *v,struct pageinfo *pi,void *x) { + void *ve=CB_DATA_START(pi); +@@ -168,15 +159,15 @@ get_bit(char *v,struct pageinfo *pi,void + return (v[i]>>s)&0x1; + } + +-static inline void +-set_bit(char *v,struct pageinfo *pi,void *x) { +- void *ve=CB_DATA_START(pi); +- fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1) + #define bit_set(v,i,s) (v[i]|=(1UL<cb_link,ncb++); ++ ++ return ncb; ++ ++} ++ ++ + void + GBC(enum type t) { + +@@ -1196,21 +1204,8 @@ GBC(enum type t) { + + if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();} + +- if (COLLECT_RELBLOCK_P) { +- +- char *new_start=heap_end+holepage*PAGESIZE,*new_end=new_start+nrbpage*PAGESIZE; +- +- if (new_start!=rb_start) { +- rb_pointer=new_start; +- rb_limit=new_end; +- } else { +- rb_pointer=(rb_pointer>PAGEWIDTH)); + printf("relblock: %ld bytes used %ld bytes free %ld pages\n", + (long)(rb_pointer - rb_start), (long)(rb_end - rb_pointer), nrbpage); + printf("GBC ended\n"); +@@ -1425,10 +1421,10 @@ FFN(siLheap_report)(void) { + i=sizeof(fixnum)*CHAR_SIZE-2; + i=1<>1)); + vs_push(make_fixnum(CSTACK_ALIGNMENT)); +- vs_push(make_fixnum(abs(cs_limit-cs_org)));/*CSSIZE*/ ++ vs_push(make_fixnum(labs(cs_limit-cs_org)));/*CSSIZE*/ + #if defined(IM_FIX_BASE) && defined(IM_FIX_LIM) + #ifdef LOW_IM_FIX + vs_push(make_fixnum(-LOW_IM_FIX)); +@@ -1456,14 +1452,9 @@ FFN(siLroom_report)(void) { + vs_push(make_fixnum(available_pages)); + vs_push(make_fixnum(ncbpage)); + vs_push(make_fixnum(maxcbpage)); +- { +- ufixnum ncb; +- struct contblock *cbp; +- for (ncb=0,cbp=cb_pointer;cbp;cbp=cbp->cb_link,ncb++); +- vs_push(make_fixnum(ncb)); +- } ++ vs_push(make_fixnum(count_contblocks())); + vs_push(make_fixnum(cbgbccount)); +- vs_push(make_fixnum(holepage)); ++ vs_push(make_fixnum((rb_start-heap_end)>>PAGEWIDTH)); + vs_push(make_fixnum(rb_pointer - (rb_pointerc.c_car,depth)^rtb[abs(depth%(sizeof(rtb)/sizeof(*rtb)))]; ++ h^=ihash_equal(x->c.c_car,depth)^rtb[abs((int)(depth%(sizeof(rtb)/sizeof(*rtb))))];/*FIXME: clang faulty warning*/ + x = x->c.c_cdr; + goto BEGIN; + break; +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -207,11 +207,19 @@ get_proc_meminfo_value_in_pages(const ch + + static ufixnum + get_phys_pages_no_malloc(char freep) { +- return freep ? ++ ufixnum k=freep ? + get_proc_meminfo_value_in_pages("MemFree:")+ + get_proc_meminfo_value_in_pages("Buffers:")+ + get_proc_meminfo_value_in_pages("Cached:") : + get_proc_meminfo_value_in_pages("MemTotal:"); ++ const char *e=getenv("GCL_MEM_MULTIPLE"); ++ if (e) { ++ double d; ++ massert(sscanf(e,"%lf",&d)==1); ++ massert(d>=0.0); ++ k*=d; ++ } ++ return k; + } + + #endif +@@ -221,9 +229,9 @@ void *initial_sbrk=NULL; + int + update_real_maxpage(void) { + +- ufixnum i,j,k; ++ ufixnum i,j; + void *end,*cur,*beg; +- ufixnum free_phys_pages=get_phys_pages_no_malloc(1),maxpages; ++ ufixnum maxpages; + #ifdef __MINGW32__ + static fixnum n; + +@@ -233,7 +241,7 @@ update_real_maxpage(void) { + } + #endif + +- phys_pages=get_phys_pages_no_malloc(1); ++ phys_pages=get_phys_pages_no_malloc(0); + + massert(cur=sbrk(0)); + beg=data_start ? data_start : cur; +@@ -253,15 +261,14 @@ update_real_maxpage(void) { + + maxpages=real_maxpage-page(beg); + +- free_phys_pages=free_phys_pages>maxpages ? maxpages : free_phys_pages; ++ phys_pages=phys_pages>maxpages ? maxpages : phys_pages; + + resv_pages=available_pages=0; + available_pages=check_avail_pages(); + +- for (i=t_start,j=0;i>1); ++ if (j>1); + } + + new_holepage=0; +@@ -297,15 +302,15 @@ minimize_image(void) { + fixnum i; + + empty_relblock(); +- holepage=nrbpage=0; +- core_end=rb_start=rb_end=rb_limit=rb_pointer=heap_end; ++ nrbpage=0; ++ resize_hole(0,t_relocatable); + + #ifdef GCL_GPROF + gprof_cleanup(); + #endif + + #if defined(BSD) || defined(ATT) +- mbrk(core_end); ++ mbrk(core_end=heap_end); + #endif + + cbgbccount = tm_table[t_contiguous].tm_adjgbccnt = tm_table[t_contiguous].tm_opt_maxpage = 0; +@@ -992,7 +997,6 @@ FFN(siLsave_system)(void) { + saving_system = FALSE; + + siLsave(); +- alloc_page(-(holepage+2*nrbpage)); + + } + +--- gcl-2.6.12.orig/o/nfunlink.c ++++ gcl-2.6.12/o/nfunlink.c +@@ -212,19 +212,24 @@ IapplyVector(object fun, int nargs, obje + else { abase = vs_top; + for (i=0; i < nargs ; i++, atypes >>= F_TYPE_WIDTH) + { object next = base[i]; +- int atyp = atypes & MASK_RANGE(0,F_TYPE_WIDTH); +- if (atyp == F_object) +- next = next; +- else if (atyp == F_int) +- { ASSURE_TYPE(next,t_fixnum); +- next = COERCE_F_TYPE(next,F_object,F_int);} +- else if (atyp == F_shortfloat) +- { ASSURE_TYPE(next,t_shortfloat); +- next = COERCE_F_TYPE(next,F_object,F_shortfloat);} +- else if (atyp == F_double_ptr) +- { ASSURE_TYPE(next,t_longfloat); +- next = COERCE_F_TYPE(next,F_object,F_double_ptr);} +- else {FEerror("cant get here!",0);} ++ switch (atypes & MASK_RANGE(0,F_TYPE_WIDTH)) { ++ case F_object: ++ break; ++ case F_int: ++ ASSURE_TYPE(next,t_fixnum); ++ next = COERCE_F_TYPE(next,F_object,F_int); ++ break; ++ case F_shortfloat: ++ ASSURE_TYPE(next,t_shortfloat); ++ next = COERCE_F_TYPE(next,F_object,F_shortfloat); ++ break; ++ case F_double_ptr: ++ ASSURE_TYPE(next,t_longfloat); ++ next = COERCE_F_TYPE(next,F_object,F_double_ptr); ++ break; ++ default: ++ FEerror("cant get here!",0); ++ } + vs_push(next);} + + } +--- gcl-2.6.12.orig/o/nsocket.c ++++ gcl-2.6.12/o/nsocket.c +@@ -204,7 +204,7 @@ CreateSocket(int port, char *host, int s + * attempt to do an async connect. Otherwise + * do a synchronous connect or bind. */ + { +- int status, sock, asyncConnect, curState, origState; ++ int status, sock, /* asyncConnect, */curState, origState; + struct sockaddr_in sockaddr; /* socket address */ + struct sockaddr_in mysockaddr; /* Socket address for client */ + +@@ -230,7 +230,7 @@ CreateSocket(int port, char *host, int s + + fcntl(sock, F_SETFD, FD_CLOEXEC); + +- asyncConnect = 0; ++ /* asyncConnect = 0; */ + status = 0; + if (server) { + +@@ -285,7 +285,7 @@ CreateSocket(int port, char *host, int s + sizeof(sockaddr)); + if (status < 0) { + if (errno == EINPROGRESS) { +- asyncConnect = 1; ++ /* asyncConnect = 1; */ + status = 0; + } + } +--- gcl-2.6.12.orig/o/prelink.c ++++ gcl-2.6.12/o/prelink.c +@@ -5,8 +5,14 @@ + extern FILE *stdin __attribute__((weak)); + extern FILE *stderr __attribute__((weak)); + extern FILE *stdout __attribute__((weak)); ++ ++#if RL_READLINE_VERSION < 0x0600 ++extern Function *rl_completion_entry_function __attribute__((weak)); ++extern char *rl_readline_name __attribute__((weak)); ++#else + extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); + extern const char *rl_readline_name __attribute__((weak)); ++#endif + + void + prelink_init(void) { +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -341,7 +341,7 @@ truncate_double(char *b,double d,int dp) + for (p=c1;*p && *p!='e';p++); + pp=p>c1 && p[-1]!='.' ? p-1 : p; + for (;pp>c1 && pp[-1]=='0';pp--); +- strcpy(pp,p); ++ memmove(pp,p,1+strlen(p)); + if (pp!=p && COMP(c1,&pp,d,dp)) + k=truncate_double(n=c1,d,dp); + +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -2476,6 +2476,7 @@ object in; + + /* to prevent longjmp clobber */ + i=(long)&vsp; ++ i+=i; + vsp=&vspo; + old_READtable = READtable; + old_READdefault_float_format = READdefault_float_format; +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -354,7 +354,6 @@ static int open_connection(host,server) + char *host; + int server; + { +- int res; + int pid; + int sock; + struct hostent *hp; +@@ -396,9 +395,9 @@ int server; + } + + #ifdef OVM_IO +- res = fcntl(sock,F_SETFL,FASYNC | FNDELAY); ++ fcntl(sock,F_SETFL,FASYNC | FNDELAY); + #else +- res = fcntl(sock,F_SETFL,FASYNC); ++ fcntl(sock,F_SETFL,FASYNC); + #endif + return(sock); + } +--- gcl-2.6.12.orig/o/sockets.c ++++ gcl-2.6.12/o/sockets.c +@@ -338,7 +338,7 @@ DEFUN_NEW("OUR-READ-WITH-OFFSET",object, + OO,OI,II,OO,(object fd,object buffer,fixnum offset,fixnum nbytes,fixnum timeout), + "Read from STATE-FD into string BUFFER putting data at OFFSET and reading NBYTES, waiting for TIMEOUT before failing") + +-{ return make_fixnum(read1(OBJ_TO_CONNECTION_STATE(fd),&((buffer)->ust.ust_self[offset]),nbytes,timeout)); ++{ return make_fixnum(read1(OBJ_TO_CONNECTION_STATE(fd),&((buffer)->st.st_self[offset]),nbytes,timeout)); + } + + +--- gcl-2.6.12.orig/o/unexelf.c ++++ gcl-2.6.12/o/unexelf.c +@@ -660,7 +660,7 @@ unexec (char *new_name, char *old_name, + int n, nn; + int old_bss_index, old_sbss_index; + int old_data_index, new_data2_index; +- int old_mdebug_index; ++ /* int old_mdebug_index; */ + struct stat stat_buf; + + /* Open the old file, allocate a buffer of the right size, and read +@@ -703,8 +703,8 @@ unexec (char *new_name, char *old_name, + + /* Find the mdebug section, if any. */ + +- old_mdebug_index = find_section (".mdebug", old_section_names, +- old_name, old_file_h, old_section_h, 1); ++ /* old_mdebug_index = find_section (".mdebug", old_section_names, */ ++ /* old_name, old_file_h, old_section_h, 1); */ + + /* Find the old .bss section. Figure out parameters of the new + * data2 and bss sections. +--- gcl-2.6.12.orig/xgcl-2/gcl_general.lsp ++++ gcl-2.6.12/xgcl-2/gcl_general.lsp +@@ -61,7 +61,7 @@ + + ;; General routines. + (defCfun "object lisp_string(object a_string, fixnum c_string) " 0 +- "extern long strlen(const char *);" ++ "extern unsigned long strlen(const char *);" + "fixnum len = strlen((void *)c_string);" + "a_string->st.st_dim = len;" + "a_string->st.st_fillp = len;" diff --git a/patches/Version_2_6_13pre13 b/patches/Version_2_6_13pre13 new file mode 100644 index 00000000..f019ef78 --- /dev/null +++ b/patches/Version_2_6_13pre13 @@ -0,0 +1,103 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-12) unstable; urgency=medium + . + * Version_2_6_13pre13 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1918,7 +1918,7 @@ void + allocate_code_block_reserve(void); + + void * +-alloc_contblock_no_gc(size_t); ++alloc_contblock_no_gc(size_t,char *); + + void + reset_contblock_freelist(void); +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1047,7 +1047,7 @@ alloc_contblock(size_t n) { + } + + void * +-alloc_contblock_no_gc(size_t n) { ++alloc_contblock_no_gc(size_t n,char *limit) { + + struct typemanager *tm=tm_of(t_contiguous); + void *p; +@@ -1057,7 +1057,7 @@ alloc_contblock_no_gc(size_t n) { + if ((p=alloc_from_freelist(tm,n))) + return p; + +- if (tpage(tm,n)<(rb_start-heap_end)>>PAGEWIDTH && (p=alloc_after_adding_pages(tm,n))) ++ if (tpage(tm,n)<(limit-heap_end)>>PAGEWIDTH && (p=alloc_after_adding_pages(tm,n))) + return p; + + return NULL; +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -431,29 +431,21 @@ collecting(void *p) { + + static ufixnum ngc_thresh; + static union {struct dummy d;ufixnum f;} rst={.f=-1}; +-/* static object lcv=Cnil; */ ++static void *static_promotion_limit; + + static inline void + mark_leaf_data(object x,void **pp,ufixnum s,ufixnum r) { + +- void *p=*pp,*dp/* ,*dpe */; ++ void *p=*pp,*dp; + + if (!marking(p)||!collecting(p)) + return; + +- /* if (lcv!=Cnil && !collecting(lcv->st.st_self) && */ +- /* (dp=PCEI(lcv->st.st_self,r)) && dp+s<=(dpe=lcv->st.st_self+lcv->st.st_dim) */ +- /* && x && x->d.st>=ngc_thresh) { */ +- + if (what_to_collect!=t_contiguous && + x && x->d.st>=ngc_thresh && +- (dp=alloc_contblock_no_gc(s))) { ++ (dp=alloc_contblock_no_gc(s,static_promotion_limit))) { + +- /* fprintf(stderr,"Promoting %p,%lu to %p\n",p,s,dp); */ +- /* fflush(stderr); */ +- + *pp=memcpy(dp,p,s); +- /* lcv->st.st_fillp=lcv->st.st_dim=(dpe-(void *)(lcv->st.st_self=dp+s)); */ + x->d.st=0; + + return; +@@ -1204,8 +1196,10 @@ GBC(enum type t) { + + if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();} + +- if (COLLECT_RELBLOCK_P) ++ if (COLLECT_RELBLOCK_P) { ++ static_promotion_limit=rb_start + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-12) unstable; urgency=medium + . + * Version_2_6_13pre13 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -2915,10 +2915,10 @@ case $canonical in + use=386-macosx + if test "$build_cpu" = "x86_64" ; then + CFLAGS="-m64 $CFLAGS"; +- LDFLAGS="-m64 -Wl,-headerpad,72 $LDFLAGS"; ++ LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; + else + CFLAGS="-m32 $CFLAGS"; +- LDFLAGS="-m32 -Wl,-headerpad,56 $LDFLAGS"; ++ LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; + fi;; + + alpha-dec-osf) +@@ -4203,7 +4203,7 @@ if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + clang="yes" +- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" ++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" + + $as_echo "#define CLANG 1" >>confdefs.h + +@@ -4246,7 +4246,12 @@ fi + if test "$GCC" = "yes" ; then + TCFLAGS="$TCFLAGS -pipe" + case $use in +- *mingw*|*gnuwin*) ++ *mingw*) ++# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." ++# echo " It is otherwise needed for the Unexec stuff to work." ++# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi ++ TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; ++ *gnuwin*) + # echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." + # echo " It is otherwise needed for the Unexec stuff to work." + # if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +@@ -5193,7 +5198,7 @@ $as_echo_n "checking \"for leading under + cat>foo.c < + #include +-int main() {FILE *f;double d=0.0;getc(f);cos(d);return 0;} ++int main() {FILE *f;double d=0.0;getc(f);d=cos(d);return 0;} + EOFF + $CC -c foo.c -o foo.o + if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then +@@ -6071,7 +6076,50 @@ $as_echo "$ac_cv_lib_tirpc_xdr_double" > + if test "x$ac_cv_lib_tirpc_xdr_double" = xyes; then : + + $as_echo "#define HAVE_XDR 1" >>confdefs.h +- TLIBS="$TLIBS -ltirpc" ++ ++ TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc" ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lgssrpc" >&5 ++$as_echo_n "checking for xdr_double in -lgssrpc... " >&6; } ++if ${ac_cv_lib_gssrpc_xdr_double+:} false; then : ++ $as_echo_n "(cached) " >&6 ++else ++ ac_check_lib_save_LIBS=$LIBS ++LIBS="-lgssrpc $LIBS" ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++/* Override any GCC internal prototype to avoid an error. ++ Use char because int might match the return type of a GCC ++ builtin and then its argument prototype would still apply. */ ++#ifdef __cplusplus ++extern "C" ++#endif ++char xdr_double (); ++int ++main () ++{ ++return xdr_double (); ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_link "$LINENO"; then : ++ ac_cv_lib_gssrpc_xdr_double=yes ++else ++ ac_cv_lib_gssrpc_xdr_double=no ++fi ++rm -f core conftest.err conftest.$ac_objext \ ++ conftest$ac_exeext conftest.$ac_ext ++LIBS=$ac_check_lib_save_LIBS ++fi ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gssrpc_xdr_double" >&5 ++$as_echo "$ac_cv_lib_gssrpc_xdr_double" >&6; } ++if test "x$ac_cv_lib_gssrpc_xdr_double" = xyes; then : ++ ++$as_echo "#define HAVE_XDR 1" >>confdefs.h ++ ++ TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lrpc" >&5 + $as_echo_n "checking for xdr_double in -lrpc... " >&6; } +@@ -6112,7 +6160,8 @@ $as_echo "$ac_cv_lib_rpc_xdr_double" >&6 + if test "x$ac_cv_lib_rpc_xdr_double" = xyes; then : + + $as_echo "#define HAVE_XDR 1" >>confdefs.h +- TLIBS="$TLIBS -lrpc" ++ ++ TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc" + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -loncrpc" >&5 + $as_echo_n "checking for xdr_double in -loncrpc... " >&6; } +@@ -6153,7 +6202,10 @@ $as_echo "$ac_cv_lib_oncrpc_xdr_double" + if test "x$ac_cv_lib_oncrpc_xdr_double" = xyes; then : + + $as_echo "#define HAVE_XDR 1" >>confdefs.h +- TLIBS="$TLIBS -loncrpc" ++ ++ TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc" ++fi ++ + fi + + fi +@@ -6870,7 +6922,6 @@ else + + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + #include "h/unrandomize.h" + return 0;} +@@ -6899,7 +6950,6 @@ else + /* end confdefs.h. */ + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK +@@ -6930,7 +6980,6 @@ else + /* end confdefs.h. */ + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK +@@ -6997,7 +7046,6 @@ else + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); +@@ -7055,7 +7103,6 @@ else + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); +@@ -7108,7 +7155,6 @@ else + + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" +@@ -7147,7 +7193,6 @@ else + + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *b,*c; + FILE *fp = fopen("conftest1","w"); +@@ -7200,7 +7245,6 @@ else + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + char *b; + FILE *fp = fopen("conftest1","w"); +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -195,10 +195,10 @@ case $canonical in + use=386-macosx + if test "$build_cpu" = "x86_64" ; then + CFLAGS="-m64 $CFLAGS"; +- LDFLAGS="-m64 -Wl,-headerpad,72 $LDFLAGS"; ++ LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; + else + CFLAGS="-m32 $CFLAGS"; +- LDFLAGS="-m32 -Wl,-headerpad,56 $LDFLAGS"; ++ LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; + fi;; + + alpha-dec-osf) +@@ -502,7 +502,7 @@ if test "$GCC" = "yes" ; then + ;}]])], + [AC_MSG_RESULT([yes]) + clang="yes" +- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body" ++ TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" + AC_DEFINE([CLANG],[1],[running clang compiler])], + [AC_MSG_RESULT([no]) + #FIXME -Wno-unused-but-set-variable when time +@@ -517,7 +517,12 @@ fi + if test "$GCC" = "yes" ; then + TCFLAGS="$TCFLAGS -pipe" + case $use in +- *mingw*|*gnuwin*) ++ *mingw*) ++# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." ++# echo " It is otherwise needed for the Unexec stuff to work." ++# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi ++ TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; ++ *gnuwin*) + # echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." + # echo " It is otherwise needed for the Unexec stuff to work." + # if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +@@ -889,7 +894,7 @@ AC_MSG_CHECKING("for leading underscore + cat>foo.c < + #include +-int main() {FILE *f;double d=0.0;getc(f);cos(d);return 0;} ++int main() {FILE *f;double d=0.0;getc(f);d=cos(d);return 0;} + EOFF + $CC -c foo.c -o foo.o + if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then +@@ -1160,9 +1165,14 @@ fi + + if test "$enable_xdr" = "yes" ; then + AC_CHECK_FUNC(xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]), +- AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -ltirpc", +- AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -lrpc", +- AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) TLIBS="$TLIBS -loncrpc")))) ++ AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc", ++ AC_CHECK_LIB(gssrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc", ++ AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc", ++ AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc"))))) + fi + + +@@ -1442,7 +1452,6 @@ if test "$HAVE_SBRK" = "1" ; then + AC_LANG_SOURCE([[ + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + #include "h/unrandomize.h" + return 0;}]])], +@@ -1453,7 +1462,6 @@ if test "$HAVE_SBRK" = "1" ; then + AC_MSG_CHECKING([that sbrk is (now) non-random]) + AC_TRY_RUN([#include + #include +- void gprof_cleanup() {}; + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK +@@ -1468,7 +1476,6 @@ if test "$HAVE_SBRK" = "1" ; then + fi + AC_TRY_RUN([#include + #include +- void gprof_cleanup() {}; + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK +@@ -1552,7 +1559,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); +@@ -1586,7 +1592,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); +@@ -1615,7 +1620,6 @@ AC_MSG_CHECKING(NEG_CSTACK_ADDRESS) + AC_RUN_IFELSE([AC_LANG_SOURCE([[ + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" +@@ -1632,7 +1636,6 @@ AC_MSG_CHECKING([finding CSTACK_ALIGNMEN + AC_RUN_IFELSE([AC_LANG_SOURCE([[ + #include + #include +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + void *b,*c; + FILE *fp = fopen("conftest1","w"); +@@ -1661,7 +1664,6 @@ AC_RUN_IFELSE([AC_LANG_SOURCE([[ + return (void *)&i; + } + +- void gprof_cleanup() {}; + int main(int argc,char **argv,char **envp) { + char *b; + FILE *fp = fopen("conftest1","w"); +--- gcl-2.6.12.orig/h/mingw.h ++++ gcl-2.6.12/h/mingw.h +@@ -243,3 +243,6 @@ extern int mingwlisten(FILE *); + #include + + ++#define NO_FILE_LOCKING /*FIXME*/ ++ ++#define sleep(n) Sleep(1000*n) +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -340,15 +340,68 @@ EXTER long holepage; /* hole pages * + #define maxrbpage tm_table[t_relocatable].tm_maxpage + #define rbgbccount tm_table[t_relocatable].tm_gbccount + EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult; +- ++ ++EXTER ufixnum recent_allocation,wait_on_abort; ++EXTER double gc_alloc_min,mem_multiple,gc_page_min,gc_page_max; ++EXTER bool multiprocess_memory_pool; + + EXTER char *new_rb_start; /* desired relblock start after next gc */ + EXTER char *rb_start; /* relblock start */ + EXTER char *rb_end; /* relblock end */ + EXTER char *rb_limit; /* relblock limit */ + EXTER char *rb_pointer; /* relblock pointer */ +-/* EXTER char *rb_start1; /\* relblock start in copy space *\/ */ +-/* EXTER char *rb_pointer1; /\* relblock pointer in copy space *\/ */ ++ ++#ifndef INLINE ++#define INLINE ++#endif ++ ++INLINE ufixnum ++rb_size(void) { ++ return rb_end-rb_start; ++} ++ ++INLINE bool ++rb_high(void) { ++ return rb_pointer>=rb_end&&rb_size(); ++} ++ ++INLINE char * ++rb_begin(void) { ++ return rb_high() ? rb_end : rb_start; ++} ++ ++INLINE bool ++rb_emptyp(void) { ++ return rb_pointer == rb_begin(); ++} ++ ++INLINE ufixnum ++ufmin(ufixnum a,ufixnum b) { ++ return a<=b ? a : b; ++} ++ ++INLINE ufixnum ++ufmax(ufixnum a,ufixnum b) { ++ return a>=b ? a : b; ++} ++ ++#include ++#include ++#include ++INLINE int ++emsg(const char *s,...) { ++ va_list args; ++ ufixnum n=0; ++ void *v=NULL; ++ va_start(args,s); ++ n=vsnprintf(v,n,s,args)+1; ++ va_end(args); ++ v=alloca(n); ++ va_start(args,s); ++ vsnprintf(v,n,s,args); ++ va_end(args); ++ return write(2,v,n-1) ? n : -1; ++} + + EXTER char *heap_end; /* heap end */ + EXTER char *core_end; /* core end */ +--- /dev/null ++++ gcl-2.6.12/h/pool.h +@@ -0,0 +1,170 @@ ++static ufixnum ++data_pages(void) { ++ ++ return page(2*(rb_end-rb_start)+((void *)heap_end-data_start)); ++ ++} ++ ++#ifndef NO_FILE_LOCKING ++ ++#include ++#include ++#include ++#include ++#include ++ ++static int pool=-1; ++static struct pool { ++ ufixnum pid; ++ ufixnum n; ++ ufixnum s; ++} *Pool; ++ ++static struct flock pl; ++ ++static const char *gcl_pool="/tmp/gcl_pool"; ++ ++static int ++set_lock(void) { ++ ++ errno=0; ++ if (fcntl(pool,F_SETLKW,&pl)) { ++ if (errno==EINTR) ++ set_lock(); ++ return -1; ++ } ++ return 0; ++ ++} ++ ++static void ++lock_pool(void) { ++ ++ pl.l_type=F_WRLCK; ++ massert(!set_lock()); ++ ++} ++ ++static void ++unlock_pool(void) { ++ ++ pl.l_type=F_UNLCK; ++ massert(!set_lock()); ++ ++} ++ ++static void ++register_pool(int s) { ++ lock_pool(); ++ Pool->n+=s; ++ Pool->s+=s*data_pages(); ++ unlock_pool(); ++} ++ ++static void ++open_pool(void) { ++ ++ if (pool==-1) { ++ ++ struct flock f; ++ ++ massert((pool=open(gcl_pool,O_CREAT|O_RDWR,0644))!=-1); ++ massert(!ftruncate(pool,sizeof(struct pool))); ++ massert((Pool=mmap(NULL,sizeof(struct pool),PROT_READ|PROT_WRITE,MAP_SHARED,pool,0))!=(void *)-1); ++ ++ pl.l_type=F_WRLCK; ++ pl.l_whence=SEEK_SET; ++ pl.l_start=sizeof(Pool->pid);; ++ pl.l_len=0; ++ ++ f=pl; ++ f.l_start=0; ++ f.l_len=sizeof(Pool->pid); ++ ++ if (!fcntl(pool,F_SETLK,&f)) { ++ ++ Pool->pid=getpid(); ++ ++ lock_pool(); ++ Pool->n=0; ++ Pool->s=0; ++ unlock_pool(); ++ ++ f.l_type=F_UNLCK; ++ massert(!fcntl(pool,F_SETLK,&f)); ++ ++ fprintf(stderr,"Initializing pool\n"); ++ fflush(stderr); ++ ++ } ++ ++ f.l_type=F_RDLCK; ++ massert(!fcntl(pool,F_SETLK,&f)); ++ ++ register_pool(1); ++ massert(!atexit(close_pool)); ++ ++ } ++ ++} ++#endif ++ ++void ++close_pool(void) { ++ ++#ifndef NO_FILE_LOCKING ++ if (pool!=-1) { ++ register_pool(-1); ++ massert(!close(pool)); ++ massert(!munmap(Pool,sizeof(struct pool))); ++ pool=-1; ++ } ++#endif ++ ++} ++ ++static void ++update_pool(fixnum val) { ++ ++#ifndef NO_FILE_LOCKING ++ if (multiprocess_memory_pool) { ++ open_pool(); ++ lock_pool(); ++ Pool->s+=val; ++ unlock_pool(); ++ } ++#endif ++ ++} ++ ++static ufixnum ++get_pool(void) { ++ ++ ufixnum s; ++ ++#ifndef NO_FILE_LOCKING ++ if (multiprocess_memory_pool) { ++ ++ open_pool(); ++ lock_pool(); ++ s=Pool->s; ++ unlock_pool(); ++ ++ } else ++#endif ++ ++ s=data_pages(); ++ ++ return s; ++ ++} ++ ++ ++static void ++pool_check(void) { ++ ++ /* if (pool!=-1) */ ++ /* massert(get_pool()==data_pages() */ ++ /* ||!fprintf(stderr,"%lu %lu %lu\n",get_pool(),page((void *)heap_end-data_start),page(((rb_end-rb_start))))); */ ++ ++} +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1951,7 +1951,16 @@ ufixnum + sum_maxpages(void); + + void +-resize_hole(ufixnum,enum type); ++resize_hole(ufixnum,enum type,bool); + + void +-setup_rb(void); ++setup_rb(bool); ++ ++void ++close_pool(void); ++ ++void ++gcl_cleanup(int); ++ ++void ++do_gcl_abort(void); +--- gcl-2.6.12.orig/h/unrandomize.h ++++ gcl-2.6.12/h/unrandomize.h +@@ -49,10 +49,10 @@ + } + n[k]="GCL_UNRANDOMIZE=t"; + n[k+1]=0; +-#ifdef GCL_GPROF +- gprof_cleanup(); +-#endif + errno=0; ++#ifdef HAVE_GCL_CLEANUP ++ gcl_cleanup(0); ++#endif + execve(*a,a,n); + printf("execve failure %d\n",errno); + exit(-1); +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -89,7 +89,7 @@ + + (when (boundp '*system-banner*) + (format t *system-banner*) +- (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*)) ++ (format t "Temporary directory for compiler files:~%~a~%" *tmp-dir*)) + + (loop + (setq +++ ++ ++ + + -) +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -38,6 +38,8 @@ Foundation, 675 Mass Ave, Cambridge, MA + static int + t_from_type(object); + ++#include "pool.h" ++ + + DEFVAR("*AFTER-GBC-HOOK*",sSAafter_gbc_hookA,SI,sLnil,""); + DEFVAR("*IGNORE-MAXIMUM-PAGES*",sSAignore_maximum_pagesA,SI,sLt,""); +@@ -67,7 +69,6 @@ sbrk1(n) + + long starting_hole_div=10; + long starting_relb_heap_mult=2; +-long new_holepage; + long resv_pages=0; + + #ifdef BSD +@@ -317,7 +318,7 @@ empty_relblock(void) { + object o=sSAleaf_collection_thresholdA->s.s_dbind; + + sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(0); +- for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;) { ++ for (;!rb_emptyp();) { + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } +@@ -326,40 +327,44 @@ empty_relblock(void) { + } + + void +-setup_rb(void) { ++setup_rb(bool preserve_rb_pointerp) { + +- int init=new_rb_start!=rb_start || rb_pointer>=rb_end; ++ int lowp=new_rb_start!=rb_start || rb_high(); + ++ update_pool(2*(nrbpage-page(rb_size()))); + rb_start=new_rb_start; + rb_end=rb_start+(nrbpage<>PAGEWIDTH))); + + } + + void +-resize_hole(ufixnum hp,enum type tp) { ++resize_hole(ufixnum hp,enum type tp,bool in_placep) { + +- char *start=rb_pointer=start) || (new_rb_start=start+size)) { +- fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp); +- fflush(stderr); ++ if (!in_placep && ++ ((new_start<=start && starttm_adjgbccnt--; + GBC(tp); +- } else +- setup_rb(); ++ } + + } + +@@ -378,11 +383,13 @@ alloc_page(long n) { + fixnum d=available_pages-nn; + + d*=0.2; +- d=d<0.01*real_maxpage ? available_pages-n : d; ++ d=d<0.01*real_maxpage ? available_pages-nn : d; + d=d<0 ? 0 : d; +- d=new_holepage(void *)core_end) { ++ update_pool(nn); ++ pool_check(); ++ ++ } else if (v>(void *)core_end) { + + massert(!mbrk(v)); + core_end=v; +@@ -510,94 +519,6 @@ grow_linear(fixnum old, fixnum fract, fi + DEFVAR("*OPTIMIZE-MAXIMUM-PAGES*",sSAoptimize_maximum_pagesA,SI,sLnil,""); + #define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil) + DEFVAR("*NOTIFY-OPTIMIZE-MAXIMUM-PAGES*",sSAnotify_optimize_maximum_pagesA,SI,sLnil,""); +-#define MMAX_PG(a_) (a_)->tm_maxpage-(a_)->tm_alt_npage +- +-static int +-rebalance_maxpages(struct typemanager *my_tm,fixnum z) { +- +- fixnum d; +- ufixnum i,j,r=(my_tm->tm_type==t_relocatable ? 2 : 1); +- +- +- d=(z-my_tm->tm_maxpage)*r; +- j=sum_maxpages(); +- +- if (j+d>phys_pages) { +- +- ufixnum k,e=j+d-phys_pages; +- double f; +- +- for (k=0,i=t_start;ik ? k : e; +- if (e+phys_pages<=j) +- return 0; +- +- f=k ? 1.0-(double)e/k : 1.0; +- +- for (i=t_start;itm_maxpage*r+(phys_pages-sum_maxpages()))/r)); +- +- return 1; +- +- } else +- +- return set_tm_maxpage(my_tm,z); +- +-} +- +-long +-opt_maxpage(struct typemanager *my_tm) { +- +- double x=0.0,y=0.0,z,r; +- long mmax_page; +- struct typemanager *tm,*tme; +- long mro=0,tro=0,j; +- +- if (page(core_end)>0.8*real_maxpage) +- return 0; +- +- for (tm=tm_table,tme=tm+sizeof(tm_table)/sizeof(*tm_table);tmtm_adjgbccnt; +- y+=MMAX_PG(tm); +- } +- mmax_page=MMAX_PG(my_tm); +-#if 0 +- if (sgc_enabled) { +- y-=(tro=sgc_count_read_only_type(-1)); +- mmax_page-=(mro=sgc_count_read_only_type(my_tm->tm_type)); +- } +-#endif +- +- z=my_tm->tm_adjgbccnt/* -1 */; +- z/=(1+x-0.9*my_tm->tm_adjgbccnt); +- z*=(y-mmax_page)*mmax_page; +- z=sqrt(z); +- z=z-mmax_page>available_pages ? mmax_page+available_pages : z; +- my_tm->tm_opt_maxpage=(long)(z+my_tm->tm_alt_npage)>my_tm->tm_opt_maxpage ? (long)(z+my_tm->tm_alt_npage) : my_tm->tm_opt_maxpage; +- +- if (z<=mmax_page) +- return 0; +- +- r=((x-my_tm->tm_adjgbccnt)+ my_tm->tm_adjgbccnt*mmax_page/z)*(y-mmax_page+z); +- r/=x*y; +- +- j=r<=0.95 && rebalance_maxpages(my_tm,z+mro+my_tm->tm_alt_npage); +- +- if (sSAnotify_optimize_maximum_pagesA->s.s_dbind!=sLnil) +- printf("[type %u max %lu(%lu) opt %lu y %lu(%lu) gbcrat %f sav %f new %lu sum %lu phys %lu]\n", +- my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt/* -1 */)/(1+x-0.9*my_tm->tm_adjgbccnt),r, +- my_tm->tm_maxpage,sum_maxpages(),phys_pages); +- +- return j ? 1 : 0; +- +-} + + static object + exhausted_report(enum type t,struct typemanager *tm) { +@@ -735,14 +656,12 @@ print_cb(int print) { + massert(**cbppp==cbp); + for (k=0;cbp && cbp->cb_size==(**cbppp)->cb_size;cbpp=&cbp->cb_link,cbp=cbp->cb_link,k++); + if (print) +- fprintf(stderr,"%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); ++ emsg("%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); + } + massert(cbppp==cbsrche); + massert(*cbppp==cbpp); + massert(!**cbppp); + +- fflush(stderr); +- + } + + void +@@ -808,8 +727,8 @@ alloc_from_freelist(struct typemanager * + break; + + case t_relocatable: +- if (rb_pointer>rb_end && rb_pointer+n>rb_limit && rb_pointer+nrb_end && rb_pointer+n>rb_limit && rb_pointer+nn) + return ((rb_pointer+=n)-n); + break; +@@ -847,7 +766,7 @@ too_full_p(struct typemanager *tm) { + + switch (tm->tm_type) { + case t_relocatable: +- return 100*(rb_limit-rb_pointer)cb_link) k+=cbp->cb_size; +@@ -867,10 +786,31 @@ too_full_p(struct typemanager *tm) { + + } + ++static inline bool ++do_gc_p(struct typemanager *tm,fixnum n) { ++ ++ ufixnum cpool,pp; ++ ++ if (!GBC_enable) ++ return FALSE; ++ ++ if (!sSAoptimize_maximum_pagesA || sSAoptimize_maximum_pagesA->s.s_dbind==Cnil) ++ return tm->tm_npage+tpage(tm,n)>tm->tm_maxpage; ++ ++ if ((cpool=get_pool())<=gc_page_min*phys_pages) ++ return FALSE; ++ ++ pp=gc_page_max*phys_pages; ++ ++ return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages(); ++ ++} ++ ++ + static inline void * + alloc_after_gc(struct typemanager *tm,fixnum n) { + +- if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) { ++ if (do_gc_p(tm,n)) { + + switch (jmp_gmp) { + case 0: /* not in gmp call*/ +@@ -911,21 +851,13 @@ add_pages(struct typemanager *tm,fixnum + + case t_relocatable: + +- if (rb_pointer>rb_end && m>((rb_start-heap_end)>>PAGEWIDTH)) { +- fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); +- fflush(stderr); ++ if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { ++ emsg("Moving relblock low before expanding relblock pages\n"); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + nrbpage+=m; +- rb_limit+=m*PAGESIZE; +- if (rb_pointer>rb_end) +- rb_start-=m*PAGESIZE; +- else +- rb_end+=m*PAGESIZE; +- +- alloc_page(-(2*nrbpage+((rb_start-heap_end)>>PAGEWIDTH))); +- ++ resize_hole(page(rb_start-heap_end)-(rb_high() ? m : 0),t_relocatable,1); + break; + + default: +@@ -1011,6 +943,8 @@ alloc_mem(struct typemanager *tm,fixnum + + CHECK_INTERRUPT; + ++ recent_allocation+=n; ++ + if ((p=alloc_from_freelist(tm,n))) + return p; + if ((p=alloc_after_gc(tm,n))) +@@ -1135,7 +1069,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate + { struct typemanager *tm=(&tm_table[t_from_type(typ)]); + tm = & tm_table[tm->tm_type]; + if (tm->tm_type == t_relocatable) +- { tm->tm_npage = (rb_end-rb_start)>>PAGEWIDTH; ++ { tm->tm_npage = page(rb_size()); + tm->tm_nfree = rb_limit -rb_pointer; + } + else if (tm->tm_type == t_contiguous) +@@ -1262,7 +1196,7 @@ object malloc_list=Cnil; + void + maybe_set_hole_from_maxpages(void) { + if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) +- resize_hole(new_holepage,t_relocatable); ++ resize_hole(available_pages/3,t_relocatable,0); + } + + void +@@ -1361,10 +1295,10 @@ gcl_init_alloc(void *cs_start) { + initial_sbrk=data_start=heap_end; + first_data_page=page(data_start); + +-#ifdef GCL_GPROF +- if (new_holepage>PAGEWIDTH)); + } + + +@@ -1751,9 +1685,7 @@ DEFUN_NEW("SET-STARTING-RELBLOCK-HEAP-MU + + DEFUNM_NEW("SET-HOLE-SIZE",object,fSset_hole_size,SI,1,2,NONE,OO,OO,OO,OO,(object onpages,...),"") { + +- printf("This function is obsolete -- use SET-STARTING-HOLE-DIVISOR instead\n"); +- +- RETURN2(make_fixnum(new_holepage),make_fixnum(reserve_pages_for_signal_handler)); ++ RETURN2(make_fixnum((rb_start-heap_end)>>PAGEWIDTH),make_fixnum(reserve_pages_for_signal_handler)); + + } + +@@ -1811,7 +1743,7 @@ static char *baby_malloc(n) + if ((res +m-baby_malloc_data) > sizeof(baby_malloc_data)) + { + printf("failed in baby malloc"); +- exit(1); ++ do_gcl_abort(); + } + last_baby += m; + *((int *)res)=n; +@@ -1904,18 +1836,16 @@ free(void *ptr) { + #endif + return; + } +-#ifdef NOFREE_ERR +- return; +-#else + if (ptr!=initial_monstartup_pointer_echo) { + static void *old_ptr; + if (old_ptr==ptr) return; + old_ptr=ptr; ++#ifndef NOFREE_ERR + FEerror("free(3) error.",0); ++#endif + } + initial_monstartup_pointer_echo=NULL; + return; +-#endif + } + + void * +--- gcl-2.6.12.orig/o/error.c ++++ gcl-2.6.12/o/error.c +@@ -40,8 +40,8 @@ assert_error(const char *a,unsigned l,co + make_simple_string(a),make_fixnum(l), + make_simple_string(f),make_simple_string(n)); + else { +- fprintf(stderr,"The assertion %s on line %d of %s in function %s failed",a,l,f,n); +- exit(-1); ++ emsg("The assertion %s on line %d of %s in function %s failed",a,l,f,n); ++ do_gcl_abort(); + } + + } +@@ -386,7 +386,7 @@ DEFUN_NEW("UNIVERSAL-ERROR-HANDLER",obje + for (i = 0; i < error_fmt_string->st.st_fillp; i++) + fputc(error_fmt_string->st.st_self[i],stdout); + printf("\nLisp initialization failed.\n"); +- exit(0); ++ do_gcl_abort(); + RETURN1(x0); + } + +--- gcl-2.6.12.orig/o/fasldlsym.c ++++ gcl-2.6.12/o/fasldlsym.c +@@ -84,7 +84,7 @@ fasload(object faslfile) { + massert(!psystem(b)); + + if (!(dlp = dlopen(buf,RTLD_NOW))) { +- fputs(dlerror(),stderr); ++ emsg(dlerror()); + FEerror("Cannot open for dynamic link ~a",1,make_simple_string(filename)); + } + +@@ -94,7 +94,7 @@ fasload(object faslfile) { + memcpy(b,x->st.st_self,x->st.st_fillp); + b[x->st.st_fillp]=0; + if (!(fptr=dlsym(dlp,b))) { +- fputs(dlerror(),stderr); ++ emsg(dlerror()); + FEerror("Cannot lookup ~a in ~a",2,make_simple_string(b),make_simple_string(filename)); + } + +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -548,10 +548,8 @@ BEGIN: + + + case smm_socket: +- if (SOCKET_STREAM_FD(strm) < 2) { +- fprintf(stderr,"tried Clsing %d ! as scoket \n",SOCKET_STREAM_FD(strm)); +- fflush(stderr); +- } ++ if (SOCKET_STREAM_FD(strm) < 2) ++ emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); + else { + #ifdef HAVE_NSOCKET + if (GET_STREAM_FLAG(strm,gcl_sm_output)) +@@ -2180,10 +2178,7 @@ FFN(siLfp_input_stream)() + #ifdef HAVE_NSOCKET + + #ifdef DODEBUG +-#define dprintf(s,arg) \ +- do {fprintf(stderr,s,arg); \ +- fflush(stderr); }\ +- while(0) ++#define dprintf(s,arg) emsg(s,arg) + #else + #define dprintf(s,arg) + #endif +@@ -2457,7 +2452,7 @@ object x=Cnil; + exit(0); + break; + case -1: +- abort(); ++ do_gcl_abort(); + break; + default: + close_stream(y); +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -85,11 +85,9 @@ cb_print(void) { + struct contblock **cbpp; + int i; + +- for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) { +- fprintf(stderr,"%lu at %p\n",(*cbpp)->cb_size,*cbpp); +- fflush(stderr); +- } +- fprintf(stderr,"%u blocks\n",i); ++ for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) ++ emsg("%lu at %p\n",(*cbpp)->cb_size,*cbpp); ++ emsg("%u blocks\n",i); + return 0; + } + +@@ -285,7 +283,6 @@ long first_protectable_page =0; + static char *copy_relblock(char *p, int s); + + long real_maxpage; +-long new_holepage; + + struct apage { + char apage_self[PAGESIZE]; +@@ -1122,7 +1119,8 @@ GBC(enum type t) { + } + + ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); +- ++ recent_allocation=0; ++ + if (in_signal_handler && t == t_relocatable) + error("cant gc relocatable in signal handler"); + +@@ -1198,7 +1196,7 @@ GBC(enum type t) { + + if (COLLECT_RELBLOCK_P) { + static_promotion_limit=rb_starts.s_dbind->v.v_self; +@@ -1337,7 +1331,7 @@ GBC(enum type t) { + tm_table[(int)tm_table[i].tm_type].tm_name); + } + printf("contblock: %ld blocks %ld pages\n", count_contblocks(), ncbpage); +- printf("hole: %ld pages\n", ((rb_start-heap_end)>>PAGEWIDTH)); ++ printf("hole: %lu pages\n", (ufixnum)page(rb_start-heap_end)); + printf("relblock: %ld bytes used %ld bytes free %ld pages\n", + (long)(rb_pointer - rb_start), (long)(rb_end - rb_pointer), nrbpage); + printf("GBC ended\n"); +@@ -1362,34 +1356,6 @@ GBC(enum type t) { + + } + +- { +- extern long opt_maxpage(struct typemanager *); +- +-#define IGNORE_MAX_PAGES (sSAignore_maximum_pagesA ==0 || sSAignore_maximum_pagesA->s.s_dbind !=sLnil) +-#define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil) +- +- if (IGNORE_MAX_PAGES && OPTIMIZE_MAX_PAGES) +- opt_maxpage(tm_table+t); +- +- } +- +- /* {static int mv; */ +- /* if (!mv && COLLECT_RELBLOCK_P) { */ +- /* mv=1; */ +- /* if (relb_copied) { */ +- /* sSAstatic_promotion_areaA->s.s_dbind=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(relb_copied),make_fixnum(aet_char),Ct,make_fixnum(0))); */ +- /* fprintf(stderr,"Making static promotion area %lu bytes\n",relb_copied); */ +- /* fflush(stderr); */ +- /* relb_copied=0; */ +- /* } else { */ +- /* fprintf(stderr,"Releasing static promotion area\n"); */ +- /* fflush(stderr); */ +- /* sSAstatic_promotion_areaA->s.s_dbind=Cnil; */ +- /* } */ +- /* mv=0; */ +- /* } */ +- /* } */ +- + collect_both=0; + + END_NO_INTERRUPT; +@@ -1449,8 +1415,8 @@ FFN(siLroom_report)(void) { + vs_push(make_fixnum(count_contblocks())); + vs_push(make_fixnum(cbgbccount)); + vs_push(make_fixnum((rb_start-heap_end)>>PAGEWIDTH)); +- vs_push(make_fixnum(rb_pointer - (rb_pointercb_size,p=*cbpp;*cbpp && (*cbpp)->cb_size==s;i+=(*cbpp)->cb_size,j++,k++,cbpp=&(*cbpp)->cb_link); +- fprintf(stderr,"%lu %lu starting at %p\n",k,s,p); ++ emsg("%lu %lu starting at %p\n",k,s,p); + } +- fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j); ++ emsg("\nTotal free %lu in %lu pieces\n\n",i,j); + + for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) +- fprintf(stderr,"%lu pages at %p\n",(unsigned long)v->in_use,v); +- fprintf(stderr,"\nTotal pages %lu in %lu pieces\n\n",i,j); ++ emsg("%lu pages at %p\n",(unsigned long)v->in_use,v); ++ emsg("\nTotal pages %lu in %lu pieces\n\n",i,j); + + for (i=j=0,v=cell_list_head;v;v=v->next) + if (tm->tm_type==v->type) { +@@ -1548,13 +1514,13 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + for (p=pagetochar(page(v)),k=0;ktm_nppage;k++,p+=tm->tm_size) { + object o=p; + if (!is_free(o) && type_of(o)==t_cfdata && (void *)o->cfd.cfd_start>=data_start) { +- fprintf(stderr,"%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start); ++ emsg("%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start); + i+=o->cfd.cfd_size; + j++; + } + } + } +- fprintf(stderr,"\nTotal code bytes %lu in %lu pieces\n",i,j); ++ emsg("\nTotal code bytes %lu in %lu pieces\n",i,j); + + for (i=j=0,v=cell_list_head;v;v=v->next) { + struct typemanager *tm=tm_of(v->type); +@@ -1616,14 +1582,14 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + break; + } + if (d>=data_start && d<(void *)heap_end && s) { +- fprintf(stderr,"%lu %s bytes at %p\n",s,tm_table[type_of(o)].tm_name,d); ++ emsg("%lu %s bytes at %p\n",s,tm_table[type_of(o)].tm_name,d); + i+=s; + j++; + } + } + } + } +- fprintf(stderr,"\nTotal leaf bytes %lu in %lu pieces\n",i,j); ++ emsg("\nTotal leaf bytes %lu in %lu pieces\n",i,j); + + return Cnil; + +--- gcl-2.6.12.orig/o/gcl_readline.d ++++ gcl-2.6.12/o/gcl_readline.d +@@ -42,6 +42,8 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include + #include + #include ++#include ++#include + #include + #include + +--- gcl-2.6.12.orig/o/gmp.c ++++ gcl-2.6.12/o/gmp.c +@@ -9,7 +9,7 @@ static void *gcl_gmp_realloc(void *oldme + { + unsigned int *old,*new; + if (!jmp_gmp) { /* No gc in alloc if jmp_gmp */ +- if (MP_SELF(big_gcprotect)) abort(); ++ if (MP_SELF(big_gcprotect)) do_gcl_abort(); + MP_SELF(big_gcprotect)=oldmem; + MP_ALLOCATED(big_gcprotect)=oldsize/MP_LIMB_SIZE; + } +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -204,26 +204,89 @@ get_proc_meminfo_value_in_pages(const ch + massert(!strncmp(c+m," kB\n",4)); + return n>>(PAGEWIDTH-10); + } +- ++ + static ufixnum + get_phys_pages_no_malloc(char freep) { +- ufixnum k=freep ? ++ ++ return freep ? + get_proc_meminfo_value_in_pages("MemFree:")+ + get_proc_meminfo_value_in_pages("Buffers:")+ + get_proc_meminfo_value_in_pages("Cached:") : + get_proc_meminfo_value_in_pages("MemTotal:"); +- const char *e=getenv("GCL_MEM_MULTIPLE"); +- if (e) { +- double d; +- massert(sscanf(e,"%lf",&d)==1); +- massert(d>=0.0); +- k*=d; +- } +- return k; ++ + } + + #endif + ++static ufixnum ++get_phys_pages(char freep) { ++ ++ return get_phys_pages_no_malloc(freep); ++ ++} ++ ++static void ++get_gc_environ(void) { ++ ++ const char *e;; ++ ++ mem_multiple=1.0; ++ if ((e=getenv("GCL_MEM_MULTIPLE"))) { ++ massert(sscanf(e,"%lf",&mem_multiple)==1); ++ massert(mem_multiple>=0.0); ++ } ++ ++ gc_alloc_min=0.1; ++ if ((e=getenv("GCL_GC_ALLOC_MIN"))) { ++ massert(sscanf(e,"%lf",&gc_alloc_min)==1); ++ massert(gc_alloc_min>=0.0); ++ } ++ ++ gc_page_min=0.5; ++ if ((e=getenv("GCL_GC_PAGE_THRESH"))) { ++ massert(sscanf(e,"%lf",&gc_page_min)==1); ++ massert(gc_page_min>=0.0); ++ } ++ ++ gc_page_max=0.75; ++ if ((e=getenv("GCL_GC_PAGE_MAX"))) { ++ massert(sscanf(e,"%lf",&gc_page_max)==1); ++ massert(gc_page_max>=0.0); ++ } ++ ++ multiprocess_memory_pool=(e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && *e; ++ ++ wait_on_abort=0; ++ if ((e=getenv("GCL_WAIT_ON_ABORT"))) ++ massert(sscanf(e,"%lu",&wait_on_abort)==1); ++ ++} ++ ++static void ++setup_maxpages(double scale) { ++ ++ void *beg=data_start ? data_start : sbrk(0); ++ ufixnum maxpages=real_maxpage-page(beg),npages,i; ++ ++ for (npages=0,i=t_start;i=npages); ++ ++ maxpages*=scale; ++ phys_pages*=scale; ++ real_maxpage=maxpages+page(beg); ++ ++ resv_pages=available_pages=0; ++ available_pages=check_avail_pages(); ++ ++ resv_pages=40PAGESIZE;j>>=1) +@@ -253,44 +313,11 @@ update_real_maxpage(void) { + } + massert(!mbrk(cur)); + +-/* phys_pages=get_phys_pages_no_malloc(0); */ +- +-/* #ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION */ +-/* if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg); */ +-/* #endif */ ++ phys_pages=ufmin(get_phys_pages(0)+page(beg),real_maxpage)-page(beg); + +- maxpages=real_maxpage-page(beg); +- +- phys_pages=phys_pages>maxpages ? maxpages : phys_pages; +- +- resv_pages=available_pages=0; +- available_pages=check_avail_pages(); ++ get_gc_environ(); ++ setup_maxpages(mem_multiple); + +- for (i=t_start;is.s_dbind!=Cnil) { +- +- for (i=t_start,j=0;i>1); +- } +- +- new_holepage=0; +- for (i=t_start;i= dend) { + minimize_image(); +- log_maxpage_bound=l; ++ log_maxpage_bound=l;/*FIXME maybe this should be under mem_multiple, not over*/ + update_real_maxpage(); + maybe_set_hole_from_maxpages(); + } +@@ -384,6 +410,43 @@ gcl_mprotect(void *v,unsigned long l,int + + DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_block_reserveA,SI,Cnil,""); + ++#define HAVE_GCL_CLEANUP ++ ++void ++gcl_cleanup(int gc) { ++ ++ if (getenv("GCL_WAIT")) ++ sleep(30); ++ ++#ifdef CLEANUP_CODE ++ CLEANUP_CODE ++#elif defined(USE_CLEANUP) ++ {extern void _cleanup(void);_cleanup();} ++#endif ++ ++#ifdef GCL_GPROF ++ gprof_cleanup(); ++#endif ++ ++ if (gc) { ++ ++ saving_system=TRUE; ++ GBC(t_other); ++ saving_system=FALSE; ++ ++ minimize_image(); ++ ++ raw_image=FALSE; ++ cs_org=0; ++ initial_sbrk=core_end; ++ ++ } ++ ++ close_pool(); ++ ++} ++ ++ + int + main(int argc, char **argv, char **envp) { + +@@ -497,6 +560,14 @@ void install_segmentation_catcher(void) + (void) gcl_signal(SIGBUS,segmentation_catcher); + } + ++void ++do_gcl_abort(void) { ++ if (wait_on_abort) ++ sleep(wait_on_abort); ++ gcl_cleanup(0); ++ abort(); ++} ++ + int catch_fatal=1; + void + error(char *s) +@@ -512,7 +583,7 @@ error(char *s) + FEerror("Caught fatal error [memory may be damaged]",0); } + printf("\nUnrecoverable error: %s.\n", s); + fflush(stdout); +- abort(); ++ do_gcl_abort(); + } + + static void +@@ -529,7 +600,7 @@ initlisp(void) { + || NULL_OR_ON_C_STACK(pagetoinfo(first_data_page)) + || NULL_OR_ON_C_STACK(core_end-1)) { + /* check person has correct definition of above */ +- fprintf(stderr,"%p %d " ++ emsg("%p %d " + #if defined(IM_FIX_BASE) + "%p %d %p %d " + #endif +@@ -941,7 +1012,7 @@ static void + FFN(siLinitialization_failure)(void) { + check_arg(0); + printf("lisp initialization failed\n"); +- exit(0); ++ do_gcl_abort(); + } + + DEFUNO_NEW("IDENTITY",object,fLidentity,LISP +@@ -970,7 +1041,6 @@ DEFUN_NEW("LISP-IMPLEMENTATION-VERSION", + RETURN1((make_simple_string(LISP_IMPLEMENTATION_VERSION))); + } + +- + static void + FFN(siLsave_system)(void) { + +@@ -990,12 +1060,6 @@ FFN(siLsave_system)(void) { + DO_BEFORE_SAVE + #endif + +- saving_system = TRUE; +- +- minimize_image(); +- +- saving_system = FALSE; +- + siLsave(); + + } +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -91,6 +91,9 @@ $(DECL): $(HDIR)/make-decl.h $(INI_FILES + grab_defs: grab_defs.c + ${CC} $(OFLAGS) -o grab_defs grab_defs.c + ++wpool: wpool.c ++ $(CC) $(CFLAGS) $(DEFS) -o $@ $< ++ + $(GCLIB): ${ALIB} + rm -f gcllib.a + $(AR) gcllib.a ${ALIB} +@@ -98,6 +101,6 @@ $(GCLIB): ${ALIB} + + clean: + rm -f $(OBJS) ${ALIB} new_init.o $(LAST_FILE) $(FIRST_FILE) *.a grab_defs$(EXE) *.ini tmpx foo.c +- rm -f cmpinclude.h new_init.c $(DECL) def undef udef.h void.h TAGS boot.h ++ rm -f cmpinclude.h new_init.c $(DECL) def undef udef.h void.h TAGS boot.h wpool + + .INTERMEDIATE: $(patsubst %.d,%.c,$(shell ls -1 *.d)) +--- gcl-2.6.12.orig/o/mingwin.c ++++ gcl-2.6.12/o/mingwin.c +@@ -8,10 +8,7 @@ + #include "stdlib.h" + + #ifdef DODEBUG +-#define dprintf(s,arg) \ +- do {fprintf(stderr,s,arg); \ +- fflush(stderr); }\ +- while(0) ++#define dprintf(s,arg) emsg(s,arg) + #else + #define dprintf(s,arg) + #endif +@@ -237,8 +234,7 @@ InitSockets() + * Initialize the winsock library and check the version number. + */ + if ((*winSock.WSAStartup)(MAKEWORD(2,2), &wsaData) != 0) { +- fprintf(stderr,"unloading"); +- fflush(stderr); ++ emsg("unloading"); + goto unloadLibrary; + } + #ifdef WSA_VERSION_REQD +@@ -380,10 +376,8 @@ CreateSocketAddress(sockaddrPtr, host, p + #ifdef DEBUG + static void myerr(char *s,int d) + { +- if (0) { +- fprintf(stderr,s,d); +- fflush(stderr); +- } ++ if (0) ++ emsg(s,d); + + } + #else +@@ -769,8 +763,7 @@ sigint() + #if 0 + BOOL WINAPI inthandler(DWORD i) + { +- fprintf(stderr,"in handler %d",i); +- fflush(stderr); ++ emsg("in handler %d",i); + terminal_interrupt(1); + return TRUE; + } +@@ -812,14 +805,14 @@ void sigterm() + #ifdef SIGABRT + void sigabrt() + { +- exit(SIGABRT); ++ do_gcl_abort(); + } + #endif + + + void sigkill() + { +- exit(SIGKILL); ++ do_gcl_abort(); + } + + +--- gcl-2.6.12.orig/o/nsocket.c ++++ gcl-2.6.12/o/nsocket.c +@@ -4,10 +4,7 @@ + #include + + #ifdef DODEBUG +-#define dprintf(s,arg) \ +- do {fprintf(stderr,s,arg); \ +- fflush(stderr); }\ +- while(0) ++#define dprintf(s,arg) emsg(s,arg) + #else + #define dprintf(s,arg) + #endif +@@ -65,7 +62,7 @@ + #endif + + #define VOID void +-#define ERROR_MESSAGE(msg) do{ fprintf(stderr,msg); exit(1) ; } while(0) ++#define ERROR_MESSAGE(msg) do{ emsg(msg); do_gcl_abort() ; } while(0) + + #ifdef STAND + +@@ -87,7 +84,7 @@ main(argc,argv) + fd = doConnect(argv[1],atoi(argv[2])); + if (fd < 0) { + perror("cant connect"); +- exit(1); ++ do_gcl_abort(); + } + + while (1) { int high; +@@ -512,8 +509,7 @@ getOneChar(FILE *fp) + int high; + /* fprintf(stderr,"",fp); + fflush(stderr); */ +- fprintf(stderr,"in getOneChar, fd=%d,fp=%p",fd,fp); +- fflush(stderr); ++ emsg("in getOneChar, fd=%d,fp=%p",fd,fp); + if (fd == 0) + { joe(fd); + return -1; +@@ -529,16 +525,14 @@ getOneChar(FILE *fp) + if (high > 0) + { + int ch ; +- fprintf(stderr,"in getOneChar, fd=%d,fp=%p",fd,fp); +- fflush(stderr); ++ emsg("in getOneChar, fd=%d,fp=%p",fd,fp); + ch = getc(fp); + if ( ch != EOF || feof(fp) ) { + /* fprintf(stderr,"< 0x%x returning %d,%c>\n",fp,ch,ch); + fflush(stderr); + */ + } +- fprintf(stderr,"in getOneChar, ch= %c,%d\n",ch,ch); +- fflush(stderr); ++ emsg("in getOneChar, ch= %c,%d\n",ch,ch); + CHECK_INTERRUPT; + if (ch != EOF) return ch; + if (feof(fp)) return EOF; +@@ -548,10 +542,7 @@ getOneChar(FILE *fp) + } + + #ifdef DODEBUG +-#define dprintf(s,arg) \ +- do {fprintf(stderr,s,arg); \ +- fflush(stderr); }\ +- while(0) ++#define dprintf(s,arg) emsg(s,arg) + #else + #define dprintf(s,arg) + #endif +--- gcl-2.6.12.orig/o/prelink.c ++++ gcl-2.6.12/o/prelink.c +@@ -2,6 +2,7 @@ + + #include "include.h" + ++#if !defined(__MINGW32__) && !defined(__CYGWIN__) + extern FILE *stdin __attribute__((weak)); + extern FILE *stderr __attribute__((weak)); + extern FILE *stdout __attribute__((weak)); +@@ -13,6 +14,7 @@ extern char *rl_readline_name __attribu + extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); + extern const char *rl_readline_name __attribute__((weak)); + #endif ++#endif + + void + prelink_init(void) { +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -390,14 +390,14 @@ edit_double(int n, double d, int *sp, ch + + truncate_double(b,d,n!=7); + +- if (isdigit(b[0])) { ++ if (isdigit((int)b[0])) { + b[1]=b[0]; + (*ep)++; + } + if (b[2]=='0') (*ep)++; + b[2] = b[1]; + p = b + 2; +- for (i=0;i sizeof(buf)) +- { fprintf(stderr,"wow that is badly defined regexp.."); +- exit(1);} ++ { emsg("wow that is badly defined regexp.."); ++ do_gcl_abort();} + regcp --; + { char *p=buf; + +@@ -567,8 +567,8 @@ regatom(int *flagp) + while (p < regcp) + { result[*(unsigned char *)p] = matches; + if (case_fold_search) +- {result[tolower(*p)] = matches; +- result[toupper(*p)] = matches; p++;} ++ {result[tolower((int)*p)] = matches; ++ result[toupper((int)*p)] = matches; p++;} + else + result[*(unsigned char *)p++] = matches; + +@@ -912,9 +912,9 @@ regexec(register regexp *prog, register + if (prog->regstart != '\0') + /* We know what char it must start with. */ + { if (case_fold_search) +- {char ch = tolower(prog->regstart); ++ {char ch = tolower((int)prog->regstart); + while (*s) +- { if (tolower(*s)==ch) ++ { if (tolower((int)*s)==ch) + {if (regtry(prog, s)) + RETURN_VAL(1);} + s++;}} +@@ -1025,12 +1025,12 @@ regmatch(char *prog) + scan = prog; + #ifdef DEBUG + if (scan != NULL && regnarrate) +- fprintf(stderr, "%s(\n", regprop(scan)); ++ emsg("%s(\n", regprop(scan)); + #endif + while (scan != NULL) { + #ifdef DEBUG + if (regnarrate) +- fprintf(stderr, "%s...\n", regprop(scan)); ++ emsg("%s...\n", regprop(scan)); + #endif + next = regnext(scan); + +@@ -1055,7 +1055,7 @@ regmatch(char *prog) + opnd = OPERAND(scan); + if (case_fold_search) + while (*opnd ) +- { if (tolower(*opnd) != tolower(*ch)) ++ { if (tolower((int)*opnd) != tolower((int)*ch)) + return 0; + else { ch++; opnd++;}} + else +@@ -1175,7 +1175,7 @@ regmatch(char *prog) + if (OP(next) == EXACTLY) + nextch = *OPERAND(next); + if (case_fold_search) +- nextch = tolower(nextch); ++ nextch = tolower((int)nextch); + min = (OP(scan) == STAR) ? 0 : 1; + save = reginput; + no = regrepeat(OPERAND(scan)); +@@ -1184,7 +1184,7 @@ regmatch(char *prog) + if (nextch == '\0' || + *reginput == nextch + || (case_fold_search && +- tolower(*reginput) == nextch)) ++ tolower((int)*reginput) == nextch)) + if (regmatch(next)) + return(1); + /* Couldn't or didn't -- back up. */ +@@ -1237,8 +1237,8 @@ regrepeat(char *p) + case EXACTLY: + { char ch = *opnd; + if (case_fold_search) +- { ch = tolower(*opnd); +- while (ch == tolower(*scan)) ++ { ch = tolower((int)*opnd); ++ while (ch == tolower((int)*scan)) + { + count++; + scan++;}} +@@ -1488,7 +1488,7 @@ min_initial_branch_length(regexp *x, uns + { op = OP(s); + next = (s) + NEXT(s); + if (op != END && op != BRANCH) +- abort(); ++ do_gcl_abort(); + s = s+3; + { int this = 0; + int anythis =0; +@@ -1509,8 +1509,8 @@ min_initial_branch_length(regexp *x, uns + n--; + while(1) + { if (case_fold_search) +- {MINIMIZE(buf[tolower(*ss)],n); +- MINIMIZE(buf[toupper(*ss)],n); ++ {MINIMIZE(buf[tolower((int)*ss)],n); ++ MINIMIZE(buf[toupper((int)*ss)],n); + } + else + { MINIMIZE(buf[*(unsigned char *)ss],n);} +@@ -1575,7 +1575,7 @@ min_initial_branch_length(regexp *x, uns + void + regerror(char *s) + { +- fprintf(stderr, "regexp error %s\n", s); ++ emsg("regexp error %s\n", s); + } + #endif + +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -140,19 +140,19 @@ void run_process ( char *name ) + if ( ! CloseHandle ( hChildStderrWrite ) ) DisplayError ( "CloseHandle: Error write" ); + + #if 0 +- fprintf ( stderr, "Before write\n" ); ++ emsg("Before write\n" ); + WriteFile ( hChildStdinWrite, chBuf, strlen ( chBuf ), + &dwWritten, NULL); + FlushFileBuffers ( hChildStdinWrite ); + FlushFileBuffers ( hChildStdoutRead ); +- fprintf ( stderr, "Before read\n" ); ++ emsg("Before read\n" ); + if ( ! ReadFile( hChildStdoutRead, chBuf, 2, &dwRead, NULL ) || + dwRead == 0 ) { + DisplayError ( "Nothing read\n" ); + } else { +- fprintf ( stderr, "Got Back: %s\n", chBuf ); ++ emsg("Got Back: %s\n", chBuf ); + } +- fprintf ( stderr, "After read\n" ); ++ emsg("After read\n" ); + #endif + + +@@ -168,8 +168,7 @@ void run_process ( char *name ) + fprintf ( ifp, "button .wibble\n" ); + fflush (ifp); + fgets ( buf, 2, ofp ); +- fprintf ( stderr, +- "run_process: ofd = %x, ofp = %x, ifd = %x, ifp = %x, buf[0] = %x, buf[1] = %x, buf = %s\n", ++ emsg("run_process: ofd = %x, ofp = %x, ifd = %x, ifp = %x, buf[0] = %x, buf[1] = %x, buf = %s\n", + ofd, ofp, ifd, ifp, buf[0], buf[1], buf ); + } + #endif +@@ -276,7 +275,7 @@ void siLrun_process() + strcat ( cmdline, " "); + } + strcat ( cmdline, vs_base[i]->st.st_self ); +- fprintf ( stderr, "siLrun_process: cmdline=%s\n", cmdline ); ++ emsg("siLrun_process: cmdline=%s\n", cmdline ); + argc++; + } + signals_allowed = sig_at_read; +@@ -540,12 +539,11 @@ char **argv; + massert(dup(fdin)>=0); + close(1); + massert(dup(fdout)>=0); +- fprintf(stderr, "\n***** Spawning process %s ", pname); ++ emsg("\n***** Spawning process %s ", pname); + if (execvp(pname, argv) == -1) + { +- fprintf(stderr, "\n***** Error in process spawning *******"); +- fflush(stderr); +- exit(1); ++ emsg("\n***** Error in process spawning *******"); ++ do_gcl_abort(); + } + } + +@@ -604,7 +602,7 @@ getpagesize() + } + + dlclose() +-{fprintf(stderr,"calling 'dl' function sun did not supply..exitting") ;exit(1);} ++{emsg("calling 'dl' function sun did not supply..exitting") ;do_gcl_abort();} + dgettext() + {dlclose();} + dlopen() +--- gcl-2.6.12.orig/o/save.c ++++ gcl-2.6.12/o/save.c +@@ -20,21 +20,12 @@ LFD(siLsave)(void) { + + char filename[256]; + extern char *kcl_self; +- extern void *initial_sbrk; + + check_arg(1); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); + coerce_to_filename(vs_base[0], filename); + +-#ifdef CLEANUP_CODE +- CLEANUP_CODE +-#elif defined(USE_CLEANUP) +- _cleanup(); +-#endif +- +- raw_image=FALSE; +- cs_org=0; +- initial_sbrk=core_end; ++ gcl_cleanup(1); + + #ifdef MEMORY_SAVE + MEMORY_SAVE(kcl_self,filename); +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -175,7 +175,7 @@ relocate_symbols(struct syment *sym,stru + if ((answ=find_sym_ptable(s))) + sym->n_value=answ->address; + else +- massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",s)); ++ massert(!emsg("Unrelocated non-local symbol: %s\n",s)); + + if (c) + sym->n.n_name[8]=c; +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -181,7 +181,7 @@ relocate(Sym *sym1,void *v,ul a,ul start + #include RELOC_H + + default: +- fprintf(stderr, "Unknown reloc type %lu\n", tp); ++ emsg("Unknown reloc type %lu\n", tp); + massert(tp&~tp); + + } +@@ -234,7 +234,7 @@ relocate_symbols(Sym *sym,Sym *syme,Shdr + sym->st_value=a->address; + + else if (ELF_ST_BIND(sym->st_info)!=STB_LOCAL) +- massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",st1+sym->st_name)); ++ massert(!emsg("Unrelocated non-local symbol: %s\n",st1+sym->st_name)); + + } + +--- gcl-2.6.12.orig/o/sfasli.c ++++ gcl-2.6.12/o/sfasli.c +@@ -146,6 +146,15 @@ use_symbols(double d,...) { + + } + #endif ++#else ++int ++use_symbols(double d,...) { ++ ++ d=sin(d)+cos(d); ++ ++ return (int)d; ++ ++} + #endif + + void +--- gcl-2.6.12.orig/o/sfaslmacho.c ++++ gcl-2.6.12/o/sfaslmacho.c +@@ -144,7 +144,7 @@ relocate_symbols(struct nlist *n1,struct + else if ((nd=find_sym_ptable(st1+n->n_un.n_strx))) + n->n_value=nd->address; + else if (n->n_type&(N_PEXT|N_EXT)) +- massert(!fprintf(stderr,"Unrelocated non-local symbol: %s\n",st1+n->n_un.n_strx)); ++ massert(!emsg("Unrelocated non-local symbol: %s\n",st1+n->n_un.n_strx)); + + return 0; + +--- gcl-2.6.12.orig/o/sfaslmacosx.c ++++ gcl-2.6.12/o/sfaslmacosx.c +@@ -37,17 +37,7 @@ typedef int (*func) (); + /* Externalize the command line used to build loadable object files (a.k.a. bundles). */ + object sSAmacosx_ldcmdA = 0L; + +-static void sfasl_error (char *format, ...) +-{ +- va_list ap; +- +- va_start (ap, format); +- fprintf (stderr, "fasload: "); +- vfprintf (stderr, format, ap); +- fprintf (stderr, "\n"); +- va_end (ap); +- exit (1); +-} ++#define sfasl_error(a,b...) {emsg(a,b);do_gcl_abort();} + + /* static void get_init_name (object faslfile, char *init_fun) */ + /* { */ +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -266,32 +266,32 @@ overlap_check(struct contblock *t1,struc + + if (!inheap(t1)) { + fprintf(stderr,"%p not in heap\n",t1); +- exit(1); ++ do_gcl_abort(); + } + + for (p=t2;p;p=p->cb_link) { + + if (!inheap(p)) { + fprintf(stderr,"%p not in heap\n",t1); +- exit(1); ++ do_gcl_abort(); + } + + if ((p<=t1 && (void *)p+p->cb_size>(void *)t1) || + (t1<=p && (void *)t1+t1->cb_size>(void *)p)) { + fprintf(stderr,"Overlap %u %p %u %p\n",t1->cb_size,t1,p->cb_size,p); +- exit(1); ++ do_gcl_abort(); + } + + if (p==p->cb_link) { + fprintf(stderr,"circle detected at %p\n",p); +- exit(1); ++ do_gcl_abort(); + } + + } + + if (t1==t1->cb_link) { + fprintf(stderr,"circle detected at %p\n",t1); +- exit(1); ++ do_gcl_abort(); + } + + } +@@ -365,7 +365,7 @@ memprotect_handler_test(int sig, long co + + if (memprotect_handler_invocations) { + memprotect_result=memprotect_multiple_invocations; +- exit(-1); ++ do_gcl_abort(); + } + memprotect_handler_invocations=1; + if (faddr!=memprotect_test_address) +@@ -387,7 +387,7 @@ memprotect_test(void) { + return memprotect_result!=memprotect_success; + if (atexit(memprotect_print)) { + fprintf(stderr,"Cannot setup memprotect_print on exit\n"); +- exit(-1); ++ do_gcl_abort(); + } + + if (!(b1=alloca(2*p))) { +--- gcl-2.6.12.orig/o/sockets.c ++++ gcl-2.6.12/o/sockets.c +@@ -70,7 +70,7 @@ int w32_socket_init(void) + } else { + if (WSAStartup(0x0101, &WSAData)) { + w32_socket_initialisations = 0; +- fprintf ( stderr, "WSAStartup failed\n" ); ++ emsg("WSAStartup failed\n" ); + WSACleanup(); + rv = -1; + } +@@ -158,13 +158,9 @@ the socket. If PORT is zero do automati + #endif + (cRetry < BIND_MAX_RETRY)); + if (0) +- { +- fprintf(stderr, +- "\nAssigned automatic address to socket : port(%d), errno(%d), bind_rc(%d), iLastAddressUsed(%d), retries(%d)\n" ++ emsg("\nAssigned automatic address to socket : port(%d), errno(%d), bind_rc(%d), iLastAddressUsed(%d), retries(%d)\n" + , addr.sin_port, errno, rc, iLastAddressUsed, cRetry + ); +- fflush(stderr); +- } + } + else + { +@@ -221,8 +217,7 @@ and returns (list* named_socket fd name1 + fd = accept(fix(car(named_socket)) , (struct sockaddr *)&addr, &n); + if (fd < 0) + { +- perror("ERROR ! accept on socket failed in sock_accept_connection"); +- fflush(stderr); ++ emsg("ERROR ! accept on socket failed in sock_accept_connection"); + return Cnil; + } + x = alloc_simple_string(sizeof(struct connection_state)); +@@ -432,7 +427,7 @@ fill pointer, and this will be advanced. + + + break; +- default: abort(); ++ default: do_gcl_abort(); + } + + switch (t) { +@@ -446,7 +441,7 @@ fill pointer, and this will be advanced. + if (downcase) + while (--len>=0) + { char c = *p++; +- c=tolower(c); ++ c=tolower((int)c); + if(needs_quoting[(unsigned char)c]) + PUSH('\\'); + PUSH(c);} +--- gcl-2.6.12.orig/o/unexelf.c ++++ gcl-2.6.12/o/unexelf.c +@@ -401,7 +401,7 @@ Filesz Memsz Flags Alig + Instead we read the whole file, modify it, and write it out. */ + + #ifndef emacs +-#define fatal(a, b...) fprintf (stderr, a, ##b), exit (1) ++#define fatal(a, b...) emsg(a,##b),do_gcl_abort() + #else + #include "config.h" + extern void fatal (char *, ...); +@@ -604,7 +604,7 @@ find_section (char *name, char *section_ + for (idx = 1; idx < old_file_h->e_shnum; idx++) + { + #ifdef DEBUG +- fprintf (stderr, "Looking for %s - found %s\n", name, ++ emsg("Looking for %s - found %s\n", name, + section_names + OLD_SECTION_H (idx).sh_name); + #endif + if (!strcmp (section_names + OLD_SECTION_H (idx).sh_name, +@@ -752,13 +752,13 @@ unexec (char *new_name, char *old_name, + (new_data2_addr - OLD_SECTION_H (old_data_index).sh_addr); + + #ifdef DEBUG +- fprintf (stderr, "old_bss_index %d\n", old_bss_index); +- fprintf (stderr, "old_bss_addr %x\n", old_bss_addr); +- fprintf (stderr, "old_bss_size %x\n", old_bss_size); +- fprintf (stderr, "new_bss_addr %x\n", new_bss_addr); +- fprintf (stderr, "new_data2_addr %x\n", new_data2_addr); +- fprintf (stderr, "new_data2_size %x\n", new_data2_size); +- fprintf (stderr, "new_data2_offset %x\n", new_data2_offset); ++ emsg("old_bss_index %d\n", old_bss_index); ++ emsg("old_bss_addr %x\n", old_bss_addr); ++ emsg("old_bss_size %x\n", old_bss_size); ++ emsg("new_bss_addr %x\n", new_bss_addr); ++ emsg("new_data2_addr %x\n", new_data2_addr); ++ emsg("new_data2_size %x\n", new_data2_size); ++ emsg("new_data2_offset %x\n", new_data2_offset); + #endif + + if ((unsigned) new_bss_addr < (unsigned) old_bss_addr + old_bss_size) +@@ -806,10 +806,10 @@ unexec (char *new_name, char *old_name, + new_file_h->e_shnum += 1; + + #ifdef DEBUG +- fprintf (stderr, "Old section offset %x\n", old_file_h->e_shoff); +- fprintf (stderr, "Old section count %d\n", old_file_h->e_shnum); +- fprintf (stderr, "New section offset %x\n", new_file_h->e_shoff); +- fprintf (stderr, "New section count %d\n", new_file_h->e_shnum); ++ emsg("Old section offset %x\n", old_file_h->e_shoff); ++ emsg("Old section count %d\n", old_file_h->e_shnum); ++ emsg("New section offset %x\n", new_file_h->e_shoff); ++ emsg("New section count %d\n", new_file_h->e_shnum); + #endif + + /* Fix up a new program header. Extend the writable data segment so +--- gcl-2.6.12.orig/o/unexmacosx.c ++++ gcl-2.6.12/o/unexmacosx.c +@@ -299,18 +299,7 @@ unexec_copy (off_t dest, off_t src, ssiz + + /* Debugging and informational messages routines. */ + +-static void +-unexec_error (char *format, ...) +-{ +- va_list ap; +- +- va_start (ap, format); +- fprintf (stderr, "unexec: "); +- vfprintf (stderr, format, ap); +- fprintf (stderr, "\n"); +- va_end (ap); +- exit (1); +-} ++#define unexec_error(a,b...) emsg(a,##b),do_gcl_abort() + + /* More informational messages routines. */ + +--- gcl-2.6.12.orig/o/unexnt.c ++++ gcl-2.6.12/o/unexnt.c +@@ -108,7 +108,7 @@ void recreate_heap1() + if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) + { + printf ("Failed to find path for executable.\n"); +- exit (1); ++ do_gcl_abort(); + } + recreate_heap (executable_path); + } +@@ -156,7 +156,7 @@ _start (void) + if (GetModuleFileName (NULL, executable_path, MAX_PATH) == 0) + { + printf ("Failed to find path for executable.\n"); +- exit (1); ++ do_gcl_abort(); + } + + #if 1 +@@ -214,7 +214,7 @@ unexec (char *new_name, char *old_name, + void *entry_address) + { + #ifdef __CYGWIN32__ +- file_data in_file, out_file; ++ static file_data in_file, out_file; + char out_filename[MAX_PATH], in_filename[MAX_PATH]; + char filename[MAX_PATH]; + unsigned long size; +@@ -244,7 +244,7 @@ unexec (char *new_name, char *old_name, + strcat(filename, (strcmp (ptr, ".exe") && strcmp (ptr, ".EXE"))?".exe":""); + cygwin_conv_to_full_win32_path(filename,out_filename); + #else +- file_data in_file, out_file; ++ static file_data in_file, out_file; + char out_filename[MAX_PATH], in_filename[MAX_PATH]; + unsigned long size; + char *ptr; +@@ -284,7 +284,7 @@ unexec (char *new_name, char *old_name, + { + printf ("Failed to open %s (%ld)...bailing.\n", + in_filename, GetLastError ()); +- exit (1); ++ do_gcl_abort(); + } + + /* Get the interesting section info, like start and size of .bss... */ +@@ -305,7 +305,7 @@ unexec (char *new_name, char *old_name, + { + printf ("Failed to open %s (%ld)...bailing.\n", + out_filename, GetLastError ()); +- exit (1); ++ do_gcl_abort(); + } + + /* Set the flag (before dumping). */ +@@ -452,7 +452,7 @@ get_bss_info_from_map_file (file_data *p + { + printf ("Failed to open map file %s, error %d...bailing out.\n", + map_filename, GetLastError ()); +- exit (-1); ++ do_gcl_abort(); + } + + while (fgets (buffer, sizeof (buffer), map)) +@@ -463,7 +463,7 @@ get_bss_info_from_map_file (file_data *p + if (n != 2) + { + printf ("Failed to scan the .bss section line:\n%s", buffer); +- exit (-1); ++ do_gcl_abort(); + } + break; + } +@@ -534,7 +534,7 @@ get_section_info (file_data *p_infile) + if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) + { + printf ("Unknown EXE header in %s...bailing.\n", p_infile->name); +- exit (1); ++ do_gcl_abort(); + } + nt_header = (PIMAGE_NT_HEADERS) (((unsigned long) dos_header) + + dos_header->e_lfanew); +@@ -542,7 +542,7 @@ get_section_info (file_data *p_infile) + { + printf ("Failed to find IMAGE_NT_HEADER in %s...bailing.\n", + p_infile->name); +- exit (1); ++ do_gcl_abort(); + } + + /* Check the NT header signature ... */ +@@ -729,7 +729,7 @@ read_in_bss (char *filename) + if (file == INVALID_HANDLE_VALUE) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + /* Seek to where the .bss section is tucked away after the heap... */ +@@ -737,7 +737,7 @@ read_in_bss (char *filename) + if (SetFilePointer (file, index, NULL, FILE_BEGIN) == 0xFFFFFFFF) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + +@@ -746,7 +746,7 @@ read_in_bss (char *filename) + if (!ReadFile (file, bss_start, bss_size, &n_read, (void *)NULL)) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + CloseHandle (file); +@@ -767,7 +767,7 @@ map_in_heap (char *filename) + if (file == INVALID_HANDLE_VALUE) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + size = GetFileSize (file, &upper_size); +@@ -776,7 +776,7 @@ map_in_heap (char *filename) + if (!file_mapping) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + size = get_committed_heap_size (); +@@ -797,7 +797,7 @@ map_in_heap (char *filename) + MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE) == NULL) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + /* Seek to the location of the heap data in the executable. */ +@@ -805,7 +805,7 @@ map_in_heap (char *filename) + if (SetFilePointer (file, i, NULL, FILE_BEGIN) == 0xFFFFFFFF) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + /* Read in the data. */ +@@ -813,7 +813,7 @@ map_in_heap (char *filename) + get_committed_heap_size (), &n_read, (void *)NULL)) + { + i = GetLastError (); +- exit (1); ++ do_gcl_abort(); + } + + CloseHandle (file); +@@ -1009,7 +1009,7 @@ sbrk (ptrdiff_t increment) + if (((unsigned long) data_region_base & ~VALMASK) != 0) + { + printf ("Error: The heap was allocated in upper memory.\n"); +- exit (1); ++ do_gcl_abort(); + } + + data_region_end = data_region_base; +@@ -1090,7 +1090,7 @@ recreate_heap (char *executable_path) { + MEM_RESERVE, + PAGE_NOACCESS); + if (!tmp) +- exit (1); ++ do_gcl_abort(); + + /* We read in the data for the .bss section from the executable + first and map in the heap from the executable second to prevent +--- gcl-2.6.12.orig/o/unixsave.c ++++ gcl-2.6.12/o/unixsave.c +@@ -105,16 +105,16 @@ char *original_file, *save_file; + */ + + if (stdin != original || original->_file != 0) { +- fprintf(stderr, "Can't open the original file.\n"); +- exit(1); ++ emsg("Can't open the original file.\n"); ++ do_gcl_abort(); + } + setbuf(original, stdin_buf); + fclose(stdout); + unlink(save_file); + n = open(save_file, O_CREAT|O_WRONLY, 0777); + if (n != 1 || (save = fdopen(n, "w")) != stdout) { +- fprintf(stderr, "Can't open the save file.\n"); +- exit(1); ++ emsg("Can't open the save file.\n"); ++ do_gcl_abort(); + } + setbuf(save, stdout_buf); + +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -28,11 +28,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + + #include "include.h" + +-#ifdef _WIN32 +-#include +-#define sleep(n) Sleep(1000 * n) +-#endif +- + #ifdef ATT3B2 + #include + int +--- gcl-2.6.12.orig/o/usig.c ++++ gcl-2.6.12/o/usig.c +@@ -295,12 +295,18 @@ sigio(void) + {ifuncall1(sSsigio_interrupt,Cnil);} + + ++static void ++sigterm(void) ++{do_gcl_abort();} ++ ++ + + void + install_default_signals(void) + { gcl_signal(SIGFPE, sigfpe3); + gcl_signal(SIGPIPE, sigpipe); + gcl_signal(SIGINT, sigint); ++ gcl_signal(SIGTERM, sigterm); + gcl_signal(SIGUSR1, sigusr1); + gcl_signal(SIGIO, sigio); + gcl_signal(SIGALRM, sigalrm); +--- gcl-2.6.12.orig/o/usig2.c ++++ gcl-2.6.12/o/usig2.c +@@ -259,7 +259,7 @@ before_interrupt(struct save_for_interru + /* #define XS(a) *pp++ = * (void **) (&a); */ + #include "usig2_aux.c" + if ((pp - (&(p->save_objects)[0])) >= (sizeof(p->save_objects)/sizeof(void *))) +- abort(); ++ do_gcl_abort(); + } + #define MINN(a,b) (atoken_st_dim = MINN(token->st.st_dim,tok_leng+1); +--- /dev/null ++++ gcl-2.6.12/o/wpool.c +@@ -0,0 +1,35 @@ ++#include ++ ++#define NO_PRELINK_UNEXEC_DIVERSION ++char *rb_end=NULL,*rb_start=NULL,*heap_end=NULL; ++void *data_start=NULL; ++int use_pool=1; ++ ++#include "include.h" ++#include "page.h" ++#include "pool.h" ++ ++/*lintian*/ ++void ++assert_error(const char *a,unsigned l,const char *f,const char *n) { ++ update_pool(0); ++ get_pool(); ++ pool_check(); ++} ++ ++int ++main(int argc,char * argv[],char * envp[]) { ++ ++ int s; ++ ++ sscanf(argv[1],"%d",&s); ++ open_pool(); ++ for (;;) { ++ lock_pool(); ++ fprintf(stderr,"master pid %lu %lu processess %lu pages\n",Pool->pid,Pool->n,Pool->s); ++ fflush(stderr); ++ unlock_pool(); ++ sleep(s); ++ } ++ return 0; ++} diff --git a/patches/Version_2_6_13pre17 b/patches/Version_2_6_13pre17 new file mode 100644 index 00000000..354686f7 --- /dev/null +++ b/patches/Version_2_6_13pre17 @@ -0,0 +1,76 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-13) unstable; urgency=medium + . + * Version_2_6_13pre16 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -749,11 +749,15 @@ alloc_from_freelist(struct typemanager * + static inline void + grow_linear1(struct typemanager *tm) { + +- fixnum maxgro=resv_pages ? available_pages : 0; ++ if (!sSAoptimize_maximum_pagesA || sSAoptimize_maximum_pagesA->s.s_dbind==Cnil) { + +- if (tm->tm_type==t_relocatable) maxgro>>=1; ++ fixnum maxgro=resv_pages ? available_pages : 0; + +- set_tm_maxpage(tm,grow_linear(tm->tm_npage,tm->tm_growth_percent,tm->tm_min_grow, tm->tm_max_grow,maxgro)); ++ if (tm->tm_type==t_relocatable) maxgro>>=1; ++ ++ set_tm_maxpage(tm,grow_linear(tm->tm_npage,tm->tm_growth_percent,tm->tm_min_grow, tm->tm_max_grow,maxgro)); ++ ++ } + + } + +@@ -802,7 +806,8 @@ do_gc_p(struct typemanager *tm,fixnum n) + + pp=gc_page_max*phys_pages; + +- return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages(); ++ return page(recent_allocation)>(1.0+gc_alloc_min-(double)ufmin(cpool,pp)/pp)*data_pages() || ++ 2*tpage(tm,n)>available_pages; + + } + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -236,7 +236,7 @@ get_gc_environ(void) { + massert(mem_multiple>=0.0); + } + +- gc_alloc_min=0.1; ++ gc_alloc_min=0.05; + if ((e=getenv("GCL_GC_ALLOC_MIN"))) { + massert(sscanf(e,"%lf",&gc_alloc_min)==1); + massert(gc_alloc_min>=0.0); +@@ -280,7 +280,7 @@ setup_maxpages(double scale) { + resv_pages=available_pages=0; + available_pages=check_avail_pages(); + +- resv_pages=40 + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-14) unstable; urgency=medium + . + * Version_2_6_13pre17 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -82,7 +82,7 @@ + + (defun safe-system (string) + (multiple-value-bind +- (code result) (system (ts string)) ++ (code result) (system (mysub (ts string) "$" "\\$")) + (unless (and (zerop code) (zerop result)) + (cerror "Continues anyway." + "(SYSTEM ~S) returned a non-zero value ~D." +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -715,6 +715,7 @@ infodir + docdir + oldincludedir + includedir ++runstatedir + localstatedir + sharedstatedir + sysconfdir +@@ -821,6 +822,7 @@ datadir='${datarootdir}' + sysconfdir='${prefix}/etc' + sharedstatedir='${prefix}/com' + localstatedir='${prefix}/var' ++runstatedir='${localstatedir}/run' + includedir='${prefix}/include' + oldincludedir='/usr/include' + docdir='${datarootdir}/doc/${PACKAGE}' +@@ -1073,6 +1075,15 @@ do + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + ++ -runstatedir | --runstatedir | --runstatedi | --runstated \ ++ | --runstate | --runstat | --runsta | --runst | --runs \ ++ | --run | --ru | --r) ++ ac_prev=runstatedir ;; ++ -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ ++ | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ ++ | --run=* | --ru=* | --r=*) ++ runstatedir=$ac_optarg ;; ++ + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ +@@ -1210,7 +1221,7 @@ fi + for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ +- libdir localedir mandir ++ libdir localedir mandir runstatedir + do + eval ac_val=\$$ac_var + # Remove trailing slashes. +@@ -1363,6 +1374,7 @@ Fine tuning of the installation director + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] ++ --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] +@@ -4423,6 +4435,7 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) ++ TCFLAGS="$TCFLAGS -mplt" + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -640,6 +640,7 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) ++ TCFLAGS="$TCFLAGS -mplt" + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/h/elf32_mips_reloc.h ++++ gcl-2.6.12/h/elf32_mips_reloc.h +@@ -19,10 +19,7 @@ + case R_MIPS_CALL16: + gote=got+sym->st_size-1; + store_val(where,MASK(16),((void *)gote-(void *)got)); +- if (s>=ggot && sst_other) s=gpd=(ul)got-(sym->st_other==2 ? 0 : (ul)where); +@@ -37,7 +34,8 @@ + a+=(a&0x8000)<<1; + store_val(where,MASK(16),a); + a=0x10000|(a>>16); +- for (hr=hr ? hr : r;--r>=hr && ELF_R_TYPE(r->r_info)==R_MIPS_HI16;) +- relocate(sym1,r,a,start,got,gote); ++ for (hr=hr ? hr : r;--r>=hr;) ++ if (ELF_R_TYPE(r->r_info)==R_MIPS_HI16) ++ relocate(sym1,r,a,start,got,gote); + hr=NULL;gpd=0; + break; +--- gcl-2.6.12.orig/h/elf32_mips_reloc_special.h ++++ gcl-2.6.12/h/elf32_mips_reloc_special.h +@@ -1,65 +1,9 @@ +-static ul gpd,ggot,ggote; static Rel *hr; +- +-static int +-write_stub(ul s,ul *got,ul *gote) { +- +- *gote=(ul)(gote+2); +- *++gote=s; +- s=((void *)gote-(void *)got); +- *++gote=(0x23<<26)|(0x1c<<21)|(0x19<<16)|s; +- *++gote=(0x23<<26)|(0x19<<21)|(0x19<<16)|0; +- *++gote=0x03200008; +- *++gote=0x00200825; +- +- return 0; +- +-} +- +-static int +-make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { +- +- Shdr *ssec=sec1+sym->st_shndx; +- struct node *a; +- if ((ssec>=sece || !ALLOC_SEC(ssec)) && +- (a=find_sym_ptable(st1+sym->st_name)) && +- a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { +- q=p; +- if (q[0]==DT_MIPS_GOTSYM) +- gotsym=q[1]; +- if (q[0]==DT_MIPS_LOCAL_GOTNO) +- locgotno=q[1]; +- +- } +- massert(gotsym && locgotno); +- +- massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); +- stub=sec->sh_addr; +- stube=sec->sh_addr+sec->sh_size; +- +- massert(sec=get_section(".got",sec1,sece,sn)); +- ggot=sec->sh_addr+locgotno*sec->sh_entsize; +- ggote=sec->sh_addr+sec->sh_size; +- +- for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; +- + return 0; + + } +@@ -74,7 +18,7 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + ul q; + + for (q=0,sym=sym1;symst_name; ++ const char *s=st1+sym->st_name; + if ((sym->st_other=strcmp(s,"_gp_disp") ? (strcmp(s,"__gnu_local_gp") ? 0 : 2) : 1)) { + q++; + sym->st_info=ELF_ST_INFO(STB_LOCAL,ELF_ST_TYPE(sym->st_info)); +@@ -94,10 +38,8 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + + sym=sym1+ELF_R_SYM(r->r_info); + +- if (!sym->st_size) { ++ if (!sym->st_size) + sym->st_size=++*gs; +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- } + + } + +--- gcl-2.6.12.orig/h/elf64_mips_reloc.h ++++ gcl-2.6.12/h/elf64_mips_reloc.h +@@ -15,10 +15,7 @@ + gote=got+(a>>32)-1; + a&=MASK(32); + store_val(where,MASK(16),((void *)gote-(void *)got)); +- if (s>=ggot && s=hr && ELF_R_TYPE(ra->r_info)==R_MIPS_HI16;) +- relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote); ++ for (hr=hr ? hr : (void *)ra;--ra>=hr;) ++ if (ELF_R_TYPE(ra->r_info)==R_MIPS_HI16) ++ relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote); + } + hr=NULL; + break; +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -1,4 +1,4 @@ +-static ul ggot,ggote; static Rela *hr; ++static Rela *hr; + + #undef ELF_R_SYM + #define ELF_R_SYM(a_) (a_&0xffffffff) +@@ -7,68 +7,9 @@ static ul ggot,ggote; static Rela *hr; + #define ELF_R_FTYPE(a_) ((a_>>56)&0xff) + + static int +-write_stub(ul s,ul *got,ul *gote) { +- +- int *goti; +- +- +- *gote=(ul)(goti=(void *)(gote+2)); +- *++gote=s; +- s=((void *)gote-(void *)got); +- *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s; +- *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0; +- *goti++=0x03200008; +- *goti++=0x00200825; +- +- return 0; +- +-} +- +-static int +-make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { +- +- Shdr *ssec=sec1+sym->st_shndx; +- struct node *a; +- if ((ssec>=sece || !ALLOC_SEC(ssec)) && +- (a=find_sym_ptable(st1+sym->st_name)) && +- a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { +- q=p; +- if (q[0]==DT_MIPS_GOTSYM) +- gotsym=q[1]; +- if (q[0]==DT_MIPS_LOCAL_GOTNO) +- locgotno=q[1]; +- +- } +- massert(gotsym && locgotno); +- +- massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); +- stub=sec->sh_addr; +- stube=sec->sh_addr+sec->sh_size; +- +- massert(sec=get_section(".got",sec1,sece,sn)); +- ggot=sec->sh_addr+locgotno*sec->sh_entsize; +- ggote=sec->sh_addr+sec->sh_size; +- +- for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; +- + return 0; + + } +@@ -104,8 +45,6 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + sym->st_size|=(q<<(a*16)); + } + +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- + } + + b=sizeof(r->r_addend)*4; +--- gcl-2.6.12.orig/h/mips-linux.h ++++ gcl-2.6.12/h/mips-linux.h +@@ -21,5 +21,4 @@ + #define SPECIAL_RELOC_H "elf64_mips_reloc_special.h" + #endif + +-/*Remove when .MIPS.stubs are replaced with callable .plt entries*/ +-#define LD_BIND_NOW ++#define NEED_STACK_CHK_GUARD +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -38,26 +38,24 @@ + + + (defmacro with-input-from-string ((var string &key index start end) . body) +- (if index +- (multiple-value-bind (ds b) +- (find-declarations body) +- `(let ((,var (make-string-input-stream ,string ,start ,end))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (setf ,index (si:get-string-input-stream-index ,var))))) +- `(let ((,var (make-string-input-stream ,string ,start ,end))) +- ,@body))) ++ (multiple-value-bind (ds b) ++ (find-declarations body) ++ `(let ((,var (make-string-input-stream ,string ,start ,end))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b) ++ (when ,index (setf ,index (si:get-string-input-stream-index ,var))) ++ (when ,var (close ,var)))))) + ++(defmacro with-output-to-string ((var &optional string &key element-type) . body) ++ (multiple-value-bind (ds b) ++ (find-declarations body) ++ `(let ((,var ,(if string `(make-string-output-stream-from-string ,string) `(make-string-output-stream)))) ++ ,@ds ++ (unwind-protect ++ (progn ,@b ,@(unless string `((get-output-stream-string ,var)))) ++ (when ,var (close ,var)))))) + +-(defmacro with-output-to-string ((var &optional string) . body) +- (if string +- `(let ((,var (make-string-output-stream-from-string ,string))) +- ,@body) +- `(let ((,var (make-string-output-stream))) +- ,@body +- (get-output-stream-string ,var)))) +- + + (defun read-from-string (string + &optional (eof-error-p t) eof-value +--- gcl-2.6.12.orig/lsp/gcl_numlib.lsp ++++ gcl-2.6.12/lsp/gcl_numlib.lsp +@@ -71,29 +71,53 @@ + + (defun cis (x) (exp (* imag-one x))) + +-(defun asin (x) +- (let ((c (- (* imag-one +- (log (+ (* imag-one x) +- (sqrt (- 1.0d0 (* x x))))))))) +- (if (or (and (not (complexp x)) +- (<= x 1.0d0) +- (>= x -1.0d0) +- ) +- (zerop (imagpart c))) +- (realpart c) +- c))) +- +-(defun acos (x) +- (let ((c (- (* imag-one +- (log (+ x (* imag-one +- (sqrt (- 1.0d0 (* x x)))))))))) +- (if (or (and (not (complexp x)) +- (<= x 1.0d0) +- (>= x -1.0d0) +- ) +- (zerop (imagpart c))) +- (realpart c) +- c))) ++(defun real-asinh (x) ++ (declare (real x)) ++ (float (log (+ x (sqrt (+ 1.0 (* x x))))) (float x))) ++ ++(defun asin (z) ++ (declare (optimize (safety 1))) ++ (check-type z number) ++ (if (unless (complexp z) (<= -1 z 1)) ++ (atan z (sqrt (- 1 (* z z)))) ++ (let* ((a (sqrt (- 1 z))) ++ (b (sqrt (+ 1 z)))) ++ (complex (atan (realpart z) (realpart (* a b))) ++ (real-asinh (imagpart (* (conjugate a) b))))))) ++ ++(defun acos (z) ++ (declare (optimize (safety 1))) ++ (check-type z number) ++ (if (unless (complexp z) (<= -1 z 1)) ++ (* 2 (atan (- 1 z) (sqrt (- 1 (* z z))))) ++ (let* ((a (sqrt (- 1 z))) ++ (b (sqrt (+ 1 z)))) ++ (complex (* 2 (atan (realpart a) (realpart b))) ++ (real-asinh (imagpart (* (conjugate b) a))))))) ++ ++(defun asinh (x) ++ (declare (optimize (safety 1))) ++ (check-type x number) ++ (if (realp x) ++ (real-asinh x) ++ (let* ((r (asin (complex (- (imagpart x)) (realpart x))))) ++ (complex (imagpart r) (- (realpart r)))))) ++ ++(defun acosh (z) ++ (declare (optimize (safety 1))) ++ (check-type z number) ++ (if (unless (complexp z) (>= z 1)) ++ (real-asinh (sqrt (- (* z z) 1))) ++ (let* ((a (sqrt (- z 1))) ++ (b (sqrt (+ z 1)))) ++ (complex (real-asinh (realpart (* (conjugate a) b))) (* 2 (atan (imagpart a) (realpart b))))))) ++ ++(defun atanh (x) ++ (declare (optimize (safety 1))) ++ (check-type x number) ++ (if (unless (complexp x) (< -1 x 1)) ++ (/ (log (/ (+ 1 x) (- 1 x))) 2) ++ (/ (- (log (+ 1 x)) (log (- 1 x))) 2))) + + + (defun sinh (z) +@@ -140,27 +164,6 @@ + ;(defun cosh (x) (/ (+ (exp x) (exp (- x))) 2.0d0)) + (defun tanh (x) (/ (sinh x) (cosh x))) + +-(defun asinh (x) (log (+ x (sqrt (+ 1.0d0 (* x x)))))) +-;(defun acosh (x) +-; (log (+ x +-; (* (1+ x) +-; (sqrt (/ (1- x) (1+ x))))))) +-;(defun acosh (x) +-; (log (+ x +-; (sqrt (* (1- x) (1+ x)))))) +-(defun acosh (x) +- (* 2 (log (+ (sqrt (/ (1+ x) 2)) (sqrt (/ (1- x) 2)))))) +-(defun atanh (x) +- (when (or (= x 1.0d0) (= x -1.0d0)) +- (error "The argument, ~s, is a logarithmic singularity.~ +- ~%Don't be foolish, GLS." +- x)) +- (log (/ (1+ x) (sqrt (- 1 (* x x)))))) +-;; (let ((y (log (/ (1+ x) (sqrt (- 1 (* x x))))))) +-;; (if (and (= (imagpart x) 0) (complexp y)) +-;; (complex (realpart y) (- (imagpart y))) +-;; y))) +- + + (defun rational (x) + (etypecase x +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -523,7 +523,41 @@ object if_exists, if_does_not_exist; + + static void + gclFlushSocket(object); +-/* ++ ++ ++DEFUN_NEW("OPEN-STREAM-P",object,fLopen_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ check_type_stream(&x); ++ ++ switch(x->sm.sm_mode) { ++ case smm_output: ++ case smm_input: ++ case smm_io: ++ case smm_probe: ++ case smm_socket: ++ case smm_string_input: ++ case smm_string_output: ++ return x->d.tt==1 ? Cnil : Ct; ++ case smm_synonym: ++ return FFN(fLopen_stream_p)(symbol_value(x->sm.sm_object0)); ++ case smm_broadcast: ++ case smm_concatenated: ++ for (x=x->sm.sm_object0;!endp(x);x=x->c.c_cdr) ++ if (!FFN(fLopen_stream_p(x))) ++ return Cnil; ++ return Ct; ++ case smm_two_way: ++ case smm_echo: ++ if (FFN(fLopen_stream_p(STREAM_INPUT_STREAM(x)))==Cnil) ++ return Cnil; ++ return FFN(fLopen_stream_p(STREAM_OUTPUT_STREAM(x))); ++ default: ++ error("illegal stream mode"); ++ return Cnil; ++ } ++ ++} ++ /* + Close_stream(strm) closes stream strm. + The abort_flag is not used now. + */ +@@ -535,6 +569,8 @@ object strm; + object x; + + BEGIN: ++ strm->d.tt=1; ++ + switch (strm->sm.sm_mode) { + case smm_output: + if (strm->sm.sm_fp == stdout) +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -471,12 +471,6 @@ main(int argc, char **argv, char **envp) + #include "unrandomize.h" + #endif + +-#ifdef LD_BIND_NOW +-#include +-#include +-#include "ld_bind_now.h" +-#endif +- + setbuf(stdin, stdin_buf); + setbuf(stdout, stdout_buf); + #ifdef _WIN32 +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -349,7 +349,7 @@ truncate_double(char *b,double d,int dp) + for (p=c;*p && *p!='e';p++); + if (p[-1]!='.' && char_inc(c,p-1) && COMP(c,&pp,d,dp)) { + j=truncate_double(c,d,dp); +- if (j + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-15) unstable; urgency=medium + . + * Version_2_6_13pre18 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -38,23 +38,28 @@ + + + (defmacro with-input-from-string ((var string &key index start end) . body) +- (multiple-value-bind (ds b) +- (find-declarations body) +- `(let ((,var (make-string-input-stream ,string ,start ,end))) +- ,@ds +- (unwind-protect +- (progn ,@b) +- (when ,index (setf ,index (si:get-string-input-stream-index ,var))) +- (when ,var (close ,var)))))) +- ++ (let ((x (sgen "X"))) ++ (multiple-value-bind (ds b) ++ (find-declarations body) ++ `(let ((,var (make-string-input-stream ,string ,start ,end))) ++ ,@ds ++ (unwind-protect ++ ,(let ((f `(progn ,@b))) ++ (if index ++ `(let ((,x (multiple-value-list ,f))) (setf ,index (get-string-input-stream-index ,var)) (values-list ,x)) ++ f)) ++ (close ,var)))))) ++ + (defmacro with-output-to-string ((var &optional string &key element-type) . body) +- (multiple-value-bind (ds b) +- (find-declarations body) +- `(let ((,var ,(if string `(make-string-output-stream-from-string ,string) `(make-string-output-stream)))) +- ,@ds +- (unwind-protect +- (progn ,@b ,@(unless string `((get-output-stream-string ,var)))) +- (when ,var (close ,var)))))) ++ (let ((s (sgen "STRING"))(bl (sgen "BLOCK"))(e (sgen "ELEMENT-TYPE"))(x (sgen "X"))) ++ (multiple-value-bind (ds b) ++ (find-declarations body) ++ `(let* ((,s ,string)(,e ,element-type) ++ (,var (if ,s (make-string-output-stream-from-string ,s) (make-string-output-stream :element-type ,e)))) ++ ,@ds ++ (unwind-protect ++ (let ((,x (multiple-value-list (progn ,@b)))) (if ,s (values-list ,x) (get-output-stream-string ,var))) ++ (close ,var)))))) + + + (defun read-from-string (string +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -1668,12 +1668,11 @@ for the string ~S.", + 3, istart, iend, strng); + @) + +-static void +-FFN(Lmake_string_output_stream)() +-{ +- check_arg(0); +- vs_push(make_string_output_stream(64)); +-} ++@(static defun make_string_output_stream (&k element_type) ++@ ++ element_type=Cnil;/*FIXME*/ ++ @(return `make_string_output_stream(64)`) ++@) + + LFD(Lget_output_stream_string)() + { diff --git a/patches/Version_2_6_13pre1a b/patches/Version_2_6_13pre1a new file mode 100644 index 00000000..81441842 --- /dev/null +++ b/patches/Version_2_6_13pre1a @@ -0,0 +1,86 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-2) unstable; urgency=medium + . + * Version_2_6_13pre1 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1269,10 +1269,11 @@ gcl_init_alloc(void *cs_start) { + update_real_maxpage(); + + if (gcl_alloc_initialized) { +- massert(rb_start==heap_end &&rb_end==heap_end && rb_limit==heap_end && rb_pointer==heap_end); +- holepage=new_holepage; +- alloc_page(-holepage); +- rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<c.c_cdr),pp=pp->c.c_cdr) + if ((pp)->c.c_car->st.st_self == ptr) { +- /* SGC contblock pages: Its possible this is on an old page CM 20030827 */ +-/* #ifdef SGC */ +-/* insert_maybe_sgc_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */ +-/* #else */ +-/* insert_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */ +-/* #endif */ + (pp)->c.c_car->st.st_self = NULL; + *p = pp->c.c_cdr; + #ifdef GCL_GPROF + if (initial_monstartup_pointer==ptr) { ++ initial_monstartup_pointer_echo=ptr; + initial_monstartup_pointer=NULL; +- if (core_end-heap_end>=sizeof(ptr)) +- *(void **)heap_end=ptr; + } + #endif + return; +@@ -1840,12 +1835,13 @@ free(void *ptr) { + #ifdef NOFREE_ERR + return; + #else +- if (core_end-heap_end + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-2) unstable; urgency=medium + . + * Version_2_6_13pre1 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/makefile ++++ gcl-2.6.12/makefile +@@ -195,7 +195,7 @@ install1: + if gcc --version | grep -i mingw >/dev/null 2>&1 ; then if grep -i oncrpc makedefs >/dev/null 2>&1 ; then cp /mingw/bin/oncrpc.dll $(DESTDIR)$(INSTALL_LIB_DIR)/$(PORTDIR); fi ; fi + cd $(DESTDIR)$(INSTALL_LIB_DIR)/$(PORTDIR) && \ + mv $(FLISP)$(EXE) temp$(EXE) && \ +- echo '(reset-sys-paths "$(INSTALL_LIB_DIR)/")(si::save-system "$(FLISP)$(EXE)")' | ./temp$(EXE) && \ ++ echo '(si::reset-sys-paths "$(INSTALL_LIB_DIR)/")(si::save-system "$(FLISP)$(EXE)")' | ./temp$(EXE) && \ + rm -f temp$(EXE) + if [ -e "unixport/rsym$(EXE)" ] ; then cp unixport/rsym$(EXE) $(DESTDIR)$(INSTALL_LIB_DIR)/unixport/ ; fi + # ln $(SYMB) $(INSTALL_LIB_DIR)/$(PORTDIR)/$(FLISP)$(EXE) \ diff --git a/patches/Version_2_6_13pre2 b/patches/Version_2_6_13pre2 new file mode 100644 index 00000000..c9a97635 --- /dev/null +++ b/patches/Version_2_6_13pre2 @@ -0,0 +1,229 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-2) unstable; urgency=medium + . + * Version_2_6_13pre1 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/bsd.h ++++ gcl-2.6.12/h/bsd.h +@@ -33,39 +33,7 @@ filecpy(save, original, stsize - sizeof( + + extern char etext; + +- +- +- +-/* #define SET_REAL_MAXPAGE do { struct rlimit data_rlimit; \ */ +-/* extern char etext; \ */ +-/* real_maxpage = MAXPAGE ; \ */ +-/* getrlimit(RLIMIT_DATA, &data_rlimit); \ */ +-/* real_maxpage = ((unsigned int)&etext/PAGESIZE + data_rlimit.rlim_cur/PAGESIZE); \ */ +-/* if (real_maxpage > MAXPAGE) \ */ +-/* real_maxpage = MAXPAGE ; } while(0) */ +- +-#define ROUND_UP_SBRK(x) \ +- do {long i; \ +- if ((i = ((long)x & (PAGESIZE - 1)))) \ +- x=sbrk(PAGESIZE - i); } while(0); +- +-#define FIX_RANDOM_SBRK \ +-do {char *x=sbrk(0); \ +- if (core_end != x) \ +- { ROUND_UP_SBRK(x); x=sbrk(0);\ +- while (core_end < x) \ +- { \ +- core_end = core_end + PAGESIZE;} \ +- if (core_end !=x) error("Someone allocated my memory");}} while (0) +- +- +-#define INIT_ALLOC \ +- heap_end = sbrk(0); ROUND_UP_SBRK(heap_end);\ +- heap_end = core_end = sbrk(0); +- +-#define IF_ALLOCATE_ERR \ +- FIX_RANDOM_SBRK; \ +- if (core_end != sbrk(PAGESIZE*(n - m))) ++#define INIT_ALLOC heap_end = core_end = sbrk(0); + + #define SYM_EXTERNAL_P(sym) ((sym)->n_type & N_EXT) + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1935,3 +1935,6 @@ empty_relblock(void); + + fixnum + check_avail_pages(void); ++ ++inline int ++mbrk(void *); +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -223,61 +223,53 @@ resize_hole(ufixnum hp,enum type tp) { + inline void * + alloc_page(long n) { + +- fixnum d,m; +- +- if (n>=0) { ++ bool s=n<0; ++ ufixnum nn=s ? -n : n; ++ void *v,*e; ++ ++ if (!s) { + +- if (n>(holepage - (in_signal_handler? 0 : ++ if (nn>(holepage - (in_signal_handler? 0 : + available_pages-n<=reserve_pages_for_signal_handler ? 0 : + reserve_pages_for_signal_handler))) { + + +- if (in_signal_handler) { +- fprintf(stderr,"Cant do relocatable gc in signal handler. \ +-Try to allocate more space to save for allocation during signals: \ +-eg to add 20 more do (si::set-hole-size %ld %d)\n...start over ", +- new_holepage, 20+ reserve_pages_for_signal_handler); fflush(stderr); exit(1); +- } +- ++ fixnum d=available_pages-nn; + +- d=available_pages-n; + d*=0.2; + d=d<0.01*real_maxpage ? available_pages-n : d; + d=d<0 ? 0 : d; + d=new_holepagecb_size==(**cbppp)->cb_size;cbpp=&cbp->cb_link,cbp=cbp->cb_link,k++); + if (print) +- fprintf(stderr,"%lu %p %p %lu %lu\n",cbppp-cbsrch1,*cbppp,**cbppp,(**cbppp)->cb_size,k); ++ fprintf(stderr,"%lu %p %p %lu %lu\n",(unsigned long)(cbppp-cbsrch1),*cbppp,**cbppp,(**cbppp)->cb_size,k); + } + massert(cbppp==cbsrche); + massert(*cbppp==cbpp); +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -120,6 +120,7 @@ fixnum log_maxpage_bound=sizeof(fixnum)* + + inline int + mbrk(void *v) { ++ + ufixnum uv=(ufixnum)v,uc=(ufixnum)sbrk(0),ux,um; + fixnum m=((1UL<<(sizeof(fixnum)*8-1))-1); + +@@ -134,9 +135,12 @@ mbrk(void *v) { + um=uc; + ux=uv; + } ++ + if (((fixnum)(ux-um))<0) + return mbrk((void *)uc+(uvs.s_dbind=alloc_simple_string(n); +- sSAcode_block_reserveA->s.s_dbind->st.st_self=alloc_memory(n); +- +-} +- + static object + load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) { + diff --git a/patches/Version_2_6_13pre20 b/patches/Version_2_6_13pre20 new file mode 100644 index 00000000..66ade458 --- /dev/null +++ b/patches/Version_2_6_13pre20 @@ -0,0 +1,45 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-16) unstable; urgency=medium + . + * Version_2_6_13pre19 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -543,14 +543,14 @@ DEFUN_NEW("OPEN-STREAM-P",object,fLopen_ + case smm_broadcast: + case smm_concatenated: + for (x=x->sm.sm_object0;!endp(x);x=x->c.c_cdr) +- if (!FFN(fLopen_stream_p(x))) ++ if (!FFN(fLopen_stream_p)(x)) + return Cnil; + return Ct; + case smm_two_way: + case smm_echo: +- if (FFN(fLopen_stream_p(STREAM_INPUT_STREAM(x)))==Cnil) ++ if (FFN(fLopen_stream_p)(STREAM_INPUT_STREAM(x))==Cnil) + return Cnil; +- return FFN(fLopen_stream_p(STREAM_OUTPUT_STREAM(x))); ++ return FFN(fLopen_stream_p)(STREAM_OUTPUT_STREAM(x)); + default: + error("illegal stream mode"); + return Cnil; diff --git a/patches/Version_2_6_13pre22 b/patches/Version_2_6_13pre22 new file mode 100644 index 00000000..cf61cc63 --- /dev/null +++ b/patches/Version_2_6_13pre22 @@ -0,0 +1,357 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-17) unstable; urgency=medium + . + * Version_2_6_13pre20 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -6553,6 +6553,7 @@ else + + #include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "./h/enum.h" + #define OBJ_ALIGN +@@ -6681,6 +6682,7 @@ else + /* end confdefs.h. */ + #include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "h/enum.h" + #include "h/type.h" +@@ -6710,6 +6712,7 @@ else + /* end confdefs.h. */ + #include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "`pwd`/h/enum.h" + #include "`pwd`/h/type.h" +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -1301,6 +1301,7 @@ AC_MSG_CHECKING([for required object ali + AC_RUN_IFELSE([AC_LANG_PROGRAM([[ + #include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "./h/enum.h" + #define OBJ_ALIGN +@@ -1341,6 +1342,7 @@ AC_MSG_CHECKING(sizeof struct contblock) + if test "$use" = "mingw" ; then + AC_TRY_RUN([#include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "h/enum.h" + #include "h/type.h" +@@ -1357,6 +1359,7 @@ AC_TRY_RUN([#include + else + AC_TRY_RUN([#include + #define EXTER ++ #define INLINE + #include "$MP_INCLUDE" + #include "`pwd`/h/enum.h" + #include "`pwd`/h/type.h" +--- gcl-2.6.12.orig/gcl-tk/guis.h ++++ gcl-2.6.12/gcl-tk/guis.h +@@ -7,6 +7,7 @@ + #define IMMNUM_H + #define GMP_WRAPPERS_H + #define ERROR_H ++#undef INLINE + + #include "include.h" + +--- gcl-2.6.12.orig/h/elf64_mips_reloc.h ++++ gcl-2.6.12/h/elf64_mips_reloc.h +@@ -15,7 +15,10 @@ + gote=got+(a>>32)-1; + a&=MASK(32); + store_val(where,MASK(16),((void *)gote-(void *)got)); +- *gote=s+(a&~MASK(16))+((a&0x8000)<<1); ++ if (s>=ggot && s>56)&0xff) + + static int ++write_stub(ul s,ul *got,ul *gote) { ++ ++ int *goti; ++ ++ *gote=(ul)(goti=(void *)(gote+2)); ++ *++gote=s; ++ s=((void *)gote-(void *)got); ++ *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s; ++ *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0; ++ *goti++=0x03200008; ++ *goti++=0x00200825; ++ ++ return 0; ++ ++} ++ ++static int ++make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) { ++ ++ Shdr *ssec=sec1+sym->st_shndx; ++ struct node *a; ++ if ((ssec>=sece || !ALLOC_SEC(ssec)) && ++ (a=find_sym_ptable(st1+sym->st_name)) && ++ a->address>=ggot && a->addresssh_addr,pe=p+sec->sh_size;psh_entsize) { ++ q=p; ++ if (q[0]==DT_MIPS_GOTSYM) ++ gotsym=q[1]; ++ if (q[0]==DT_MIPS_LOCAL_GOTNO) ++ locgotno=q[1]; ++ } ++ massert(gotsym && locgotno); ++ ++ massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); ++ stub=sec->sh_addr; ++ stube=sec->sh_addr+sec->sh_size; ++ ++ massert(sec=get_section(".got",sec1,sece,sn)); ++ ggot=sec->sh_addr+locgotno*sec->sh_entsize; ++ ggote=sec->sh_addr+sec->sh_size; ++ ++ for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; ++ + return 0; + + } +@@ -45,6 +102,8 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + sym->st_size|=(q<<(a*16)); + } + ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ + } + + b=sizeof(r->r_addend)*4; +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -364,3 +364,13 @@ extern bool writable_malloc; + #define pfork() prof_block(fork()) + + #include "error.h" ++ ++#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) ++extern void __gmp_randget_mt (); ++extern void __gmp_randclear_mt (); ++extern void __gmp_randiset_mt (); ++ ++typedef struct {void *a,*b,*c,*d;} gmp_randfnptr_t; ++EXTER gmp_randfnptr_t Mersenne_Twister_Generator_Noseed; ++#endif ++ +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -349,11 +349,7 @@ EXTER char *new_rb_start; /* desired r + EXTER char *rb_start; /* relblock start */ + EXTER char *rb_end; /* relblock end */ + EXTER char *rb_limit; /* relblock limit */ +-EXTER char *rb_pointer; /* relblock pointer */ +- +-#ifndef INLINE +-#define INLINE +-#endif ++EXTER char *rb_pointer; /* relblock pointer */ + + INLINE ufixnum + rb_size(void) { +--- gcl-2.6.12.orig/o/big.c ++++ gcl-2.6.12/o/big.c +@@ -70,6 +70,32 @@ DEFUN_NEW("SET-GMP-ALLOCATE-RELOCATABLE" + RETURN1(flag); + } + ++#ifndef GMP_USE_MALLOC ++object big_gcprotect; ++object big_fixnum1; ++ ++#include "gmp.c" ++ ++void ++gcl_init_big1(void) { ++ ++ mp_set_memory_functions( gcl_gmp_alloc,gcl_gmp_realloc,gcl_gmp_free); ++ jmp_gmp=0; ++ ++#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) ++ Mersenne_Twister_Generator_Noseed.b=__gmp_randget_mt; ++ Mersenne_Twister_Generator_Noseed.c=__gmp_randclear_mt; ++ Mersenne_Twister_Generator_Noseed.d=__gmp_randiset_mt; ++#endif ++ ++} ++ ++#else ++gcl_init_big1() ++{ ++} ++#endif ++ + #ifdef GMP + #include "gmp_big.c" + #else +@@ -93,7 +119,6 @@ void zero_big(object x) + ZERO_BIG(x); + } + +- + #ifndef HAVE_MP_COERCE_TO_STRING + + double digitsPerBit[37]={ 0,0, +--- gcl-2.6.12.orig/o/gmp_big.c ++++ gcl-2.6.12/o/gmp_big.c +@@ -81,27 +81,6 @@ static object verify_big_or_zero(object + #define verify_big_or_zero(x) + #endif + +- +- +- +- +-#ifndef GMP_USE_MALLOC +-object big_gcprotect; +-object big_fixnum1; +- +-#include "gmp.c" +-void +-gcl_init_big1(void) { +- mp_set_memory_functions( gcl_gmp_alloc,gcl_gmp_realloc,gcl_gmp_free); +- jmp_gmp=0; +-} +- +-#else +-gcl_init_big1() +-{ +-} +-#endif +- + object + new_bignum(void) + { object ans; +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -511,9 +511,7 @@ main(int argc, char **argv, char **envp) + + terminal_io->sm.sm_object0->sm.sm_fp = stdin; + terminal_io->sm.sm_object1->sm.sm_fp = stdout; +-#ifdef LD_BIND_NOW /*FIXME currently mips only, verify that these two requirements are the same*/ +- reinit_gmp(); +-#endif ++ + gcl_init_big1(); + #ifdef HAVE_READLINE + gcl_init_readline_function(); +--- gcl-2.6.12.orig/o/num_rand.c ++++ gcl-2.6.12/o/num_rand.c +@@ -104,34 +104,6 @@ trap_gcl_gmp_allocfun(size_t size){ + } + #endif + +-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) +-extern void +-__gmp_randget_mt (); +-extern void +-__gmp_randclear_mt (); +-extern void +-__gmp_randiset_mt (); +- +-typedef struct {void *a,*b,*c,*d;} gmp_randfnptr_t; +-static gmp_randfnptr_t Mersenne_Twister_Generator_Noseed = { +- NULL, +- __gmp_randget_mt, +- __gmp_randclear_mt, +- __gmp_randiset_mt +-}; +-#endif +- +-void +-reinit_gmp() { +- +-#if __GNU_MP_VERSION > 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR >= 2) +- Mersenne_Twister_Generator_Noseed.b=__gmp_randget_mt; +- Mersenne_Twister_Generator_Noseed.c=__gmp_randclear_mt; +- Mersenne_Twister_Generator_Noseed.d=__gmp_randiset_mt; +-#endif +- +-} +- + void + init_gmp_rnd_state(__gmp_randstate_struct *x) { + +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -66,9 +66,7 @@ + *opt-two* @LI-OPT-TWO@ + *init-lsp* @LI-INIT-LSP@) + +-(import 'si::(clines defentry defcfun object void int double +- quit bye gbc system commonp +- *break-on-warnings* ++(import 'si::(commonp *break-on-warnings* + make-char char-bits char-font char-bit set-char-bit string-char-p int-char + char-font-limit char-bits-limit char-control-bit + char-meta-bit char-super-bit char-hyper-bit compiler-let) :cltl1-compat) +@@ -79,3 +77,4 @@ + #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) + + #+ansi-cl (use-package :pcl :user) ++(import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) diff --git a/patches/Version_2_6_13pre25 b/patches/Version_2_6_13pre25 new file mode 100644 index 00000000..6e13958b --- /dev/null +++ b/patches/Version_2_6_13pre25 @@ -0,0 +1,185 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-19) unstable; urgency=medium + . + * Use-dpkg-buidflags-opt-levels-in-debian-rules, -O3 has bug in 5.2.1 + * Version_2_6_13pre24 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/config.guess ++++ gcl-2.6.12/config.guess +@@ -1,8 +1,8 @@ + #! /bin/sh + # Attempt to guess a canonical system name. +-# Copyright 1992-2014 Free Software Foundation, Inc. ++# Copyright 1992-2015 Free Software Foundation, Inc. + +-timestamp='2014-03-23' ++timestamp='2015-08-20' + + # This file is free software; you can redistribute it and/or modify it + # under the terms of the GNU General Public License as published by +@@ -24,12 +24,12 @@ timestamp='2014-03-23' + # program. This Exception is an additional permission under section 7 + # of the GNU General Public License, version 3 ("GPLv3"). + # +-# Originally written by Per Bothner. ++# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. + # + # You can get the latest version of this script from: + # http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD + # +-# Please send patches with a ChangeLog entry to config-patches@gnu.org. ++# Please send patches to . + + + me=`echo "$0" | sed -e 's,.*/,,'` +@@ -50,7 +50,7 @@ version="\ + GNU config.guess ($timestamp) + + Originally written by Per Bothner. +-Copyright 1992-2014 Free Software Foundation, Inc. ++Copyright 1992-2015 Free Software Foundation, Inc. + + This is free software; see the source for copying conditions. There is NO + warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." +@@ -168,20 +168,27 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + sysctl="sysctl -n hw.machine_arch" +- UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ +- /usr/sbin/$sysctl 2>/dev/null || echo unknown)` ++ UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ ++ /sbin/$sysctl 2>/dev/null || \ ++ /usr/sbin/$sysctl 2>/dev/null || \ ++ echo unknown)` + case "${UNAME_MACHINE_ARCH}" in + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; ++ earmv*) ++ arch=`echo ${UNAME_MACHINE_ARCH} | sed -e 's,^e\(armv[0-9]\).*$,\1,'` ++ endian=`echo ${UNAME_MACHINE_ARCH} | sed -ne 's,^.*\(eb\)$,\1,p'` ++ machine=${arch}${endian}-unknown ++ ;; + *) machine=${UNAME_MACHINE_ARCH}-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently, or will in the future. + case "${UNAME_MACHINE_ARCH}" in +- arm*|i386|m68k|ns32k|sh3*|sparc|vax) ++ arm*|earm*|i386|m68k|ns32k|sh3*|sparc|vax) + eval $set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ELF__ +@@ -197,6 +204,13 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + os=netbsd + ;; + esac ++ # Determine ABI tags. ++ case "${UNAME_MACHINE_ARCH}" in ++ earm*) ++ expr='s/^earmv[0-9]/-eabi/;s/eb$//' ++ abi=`echo ${UNAME_MACHINE_ARCH} | sed -e "$expr"` ++ ;; ++ esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need +@@ -207,13 +221,13 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + release='-gnu' + ;; + *) +- release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` ++ release=`echo ${UNAME_RELEASE} | sed -e 's/[-_].*//' | cut -d. -f1,2` + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. +- echo "${machine}-${os}${release}" ++ echo "${machine}-${os}${release}${abi}" + exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` +@@ -235,6 +249,9 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ + *:MirBSD:*:*) + echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} + exit ;; ++ *:Sortix:*:*) ++ echo ${UNAME_MACHINE}-unknown-sortix ++ exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) +@@ -579,8 +596,9 @@ EOF + else + IBM_ARCH=powerpc + fi +- if [ -x /usr/bin/oslevel ] ; then +- IBM_REV=`/usr/bin/oslevel` ++ if [ -x /usr/bin/lslpp ] ; then ++ IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | ++ awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi +@@ -932,6 +950,9 @@ EOF + crisv32:Linux:*:*) + echo ${UNAME_MACHINE}-axis-linux-${LIBC} + exit ;; ++ e2k:Linux:*:*) ++ echo ${UNAME_MACHINE}-unknown-linux-${LIBC} ++ exit ;; + frv:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; +@@ -1020,7 +1041,7 @@ EOF + echo ${UNAME_MACHINE}-dec-linux-${LIBC} + exit ;; + x86_64:Linux:*:*) +- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} ++ echo ${UNAME_MACHINE}-pc-linux-${LIBC} + exit ;; + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -66,8 +66,9 @@ + *opt-two* @LI-OPT-TWO@ + *init-lsp* @LI-INIT-LSP@) + +-(import 'si::(commonp *break-on-warnings* +- make-char char-bits char-font char-bit set-char-bit string-char-p int-char ++(import 'si::(clines defentry defcfun object void int double quit bye gbc system ++ commonp *break-on-warnings* make-char char-bits char-font ++ char-bit set-char-bit string-char-p int-char + char-font-limit char-bits-limit char-control-bit + char-meta-bit char-super-bit char-hyper-bit compiler-let) :cltl1-compat) + (deftype cltl1-compat::string-char nil 'character) +@@ -77,4 +78,4 @@ + #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) + + #+ansi-cl (use-package :pcl :user) +-(import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) ++#+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) diff --git a/patches/Version_2_6_13pre26 b/patches/Version_2_6_13pre26 new file mode 100644 index 00000000..798646de --- /dev/null +++ b/patches/Version_2_6_13pre26 @@ -0,0 +1,235 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-20) unstable; urgency=medium + . + * Version_2_6_13pre25 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4435,7 +4435,6 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) +- TCFLAGS="$TCFLAGS -mplt" + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -640,7 +640,6 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) +- TCFLAGS="$TCFLAGS -mplt" + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/h/elf32_mips_reloc.h ++++ gcl-2.6.12/h/elf32_mips_reloc.h +@@ -4,7 +4,12 @@ + add_val(where,~0L,s+a-(ul)got); + break; + case R_MIPS_26: +- add_val(where,MASK(26),(s+a)>>2); ++ if (((s+a)>>28)!=(((ul)where)>>28)) { ++ gote=got+sym->st_size-1; ++ massert(!write_26_stub(s+a,got,gote)); ++ store_val(where,MASK(26),((ul)gote)>>2); ++ } else ++ add_val(where,MASK(26),(s+a)>>2); + break; + case R_MIPS_32: + add_val(where,~0L,s+a); +@@ -19,7 +24,10 @@ + case R_MIPS_CALL16: + gote=got+sym->st_size-1; + store_val(where,MASK(16),((void *)gote-(void *)got)); +- *gote=s; ++ if (s>=ggot && sst_other) s=gpd=(ul)got-(sym->st_other==2 ? 0 : (ul)where); +--- gcl-2.6.12.orig/h/elf32_mips_reloc_special.h ++++ gcl-2.6.12/h/elf32_mips_reloc_special.h +@@ -1,9 +1,88 @@ +-static ul gpd; static Rel *hr; ++#include ++ ++static ul gpd,ggot,ggote,can_gp; static Rel *hr; ++ ++typedef struct { ++ ul addr_hi,addr_lo,jr,nop; ++} mips_26_tramp; ++ ++static int ++write_26_stub(ul s,ul *got,ul *gote) { ++ ++ static mips_26_tramp t1={(0xf<<26)|(0x0<<21)|(0x19<<16), /*lui t9*/ ++ (0xe<<26)|(0x19<<21)|(0x19<<16), /*ori t9,t9 */ ++ 0x03200008, /*jr t9*/ ++ 0x00200825}; /*mv at,at */; ++ mips_26_tramp *t=(void *)gote; ++ ++ *t=t1; ++ t->addr_hi|=s>>16; ++ t->addr_lo|=s&0xffff; ++ ++ return 0; ++ ++} ++ ++typedef struct { ++ ul entry,addr_hi,addr_lo,lw,jr,lwcan; ++} call_16_tramp; ++ ++static int ++write_stub(ul s,ul *got,ul *gote) { ++ ++ static call_16_tramp t1={0, ++ (0xf<<26)|(0x0<<21)|(0x19<<16), /*lui t9*/ ++ (0xe<<26)|(0x19<<21)|(0x19<<16), /*ori t9,t9 */ ++ (0x23<<26)|(0x19<<21)|(0x19<<16), /*lw t9,(0)t9*/ ++ 0x03200008, /*jr t9*/ ++ /*stub addresses need veneer setting gp to canonical*/ ++ (0x23<<26)|(0x1c<<21)|(0x1c<<16)};/*lw gp,(0)gp*/ ++ call_16_tramp *t=(void *)gote++; ++ ++ *t=t1; ++ *got=can_gp; ++ ++ t->entry=(ul)gote; ++ t->addr_hi|=s>>16; ++ t->addr_lo|=s&0xffff; ++ ++ return 0; ++ ++} + + static int + find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, + const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { + ++ Shdr *sec; ++ ul *q,gotsym=0,locgotno=0,stub,stube; ++ void *p,*pe; ++ ++ massert(sec=get_section(".dynamic",sec1,sece,sn)); ++ for (p=(void *)sec->sh_addr,pe=p+sec->sh_size;psh_entsize) { ++ q=p; ++ if (q[0]==DT_MIPS_GOTSYM) ++ gotsym=q[1]; ++ if (q[0]==DT_MIPS_LOCAL_GOTNO) ++ locgotno=q[1]; ++ if (q[0]==DT_PLTGOT) ++ can_gp=q[1]+0x7ff0; ++ ++ } ++ massert(gotsym && locgotno && can_gp); ++ ++ massert(sec=get_section(".MIPS.stubs",sec1,sece,sn)); ++ stub=sec->sh_addr; ++ stube=sec->sh_addr+sec->sh_size; ++ ++ massert(sec=get_section(".got",sec1,sece,sn)); ++ ggot=sec->sh_addr+locgotno*sec->sh_entsize; ++ ggote=sec->sh_addr+sec->sh_size; ++ ++ for (ds1+=gotsym,sym=ds1;symst_value || (sym->st_value>=stub && sym->st_valuest_value=ggot+(sym-ds1)*sec->sh_entsize; ++ + return 0; + + } +@@ -13,9 +92,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + + Rel *r; + Sym *sym; +- Shdr *sec; ++ Shdr *sec,*ssec; + void *v,*ve; + ul q; ++ struct node *a; + + for (q=0,sym=sym1;symst_name; +@@ -29,20 +109,32 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + for (sym=sym1;symst_size=0; + +- for (*gs=0,sec=sec1;secsh_type==SHT_REL) ++ for (*gs=1,sec=sec1;secsh_type==SHT_REL)/*no addend*/ + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + +- if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| +- ELF_R_TYPE(r->r_info)==R_MIPS_GOT16) { ++ if (!(sym=sym1+ELF_R_SYM(r->r_info))->st_size) + +- sym=sym1+ELF_R_SYM(r->r_info); ++ switch(ELF_R_TYPE(r->r_info)) { + +- if (!sym->st_size) +- sym->st_size=++*gs; ++ case R_MIPS_26: ++ if (((ul)(pagetochar(page(heap_end))+r->r_offset))>>28) { ++ sym->st_size=++*gs; ++ (*gs)+=sizeof(mips_26_tramp)/sizeof(ul)-1; ++ } ++ break; ++ case R_MIPS_CALL16: ++ sym->st_size=++*gs; ++ if (((ssec=sec1+sym->st_shndx)>=sece || !ALLOC_SEC(ssec)) && ++ (a=find_sym_ptable(st1+sym->st_name)) && ++ a->address>=ggot && a->addressst_size=++*gs; ++ break; ++ } + +- } +- + return 0; + + } +--- gcl-2.6.12.orig/o/nsocket.c ++++ gcl-2.6.12/o/nsocket.c +@@ -645,11 +645,11 @@ getCharGclSocket(object strm, object blo + { int high; + AGAIN: + /* under cygwin a too large timout like (1<<30) does not work */ +- timeout.tv_sec = (block != Ct ? 0 : 0); ++ timeout.tv_sec = 0; + timeout.tv_usec = 10000; + FD_ZERO(&readfds); + FD_SET(fd,&readfds); +- high = select(fd+1,&readfds,NULL,NULL,&timeout); ++ high = select(fd+1,&readfds,NULL,NULL,block==Ct ? NULL : &timeout); + if (high > 0) + { object bufp = SOCKET_STREAM_BUFFER(strm); + int n; diff --git a/patches/Version_2_6_13pre27 b/patches/Version_2_6_13pre27 new file mode 100644 index 00000000..fea955b1 --- /dev/null +++ b/patches/Version_2_6_13pre27 @@ -0,0 +1,161 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-21) unstable; urgency=medium + . + * Version_2_6_13pre26 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/att_ext.h ++++ gcl-2.6.12/h/att_ext.h +@@ -217,6 +217,10 @@ frame_ptr frs_sch_catch(); + /* gbc.c */ + EXTER bool GBC_enable; + ++#ifdef CAN_UNRANDOMIZE_SBRK ++EXTER bool gcl_unrandomized; ++#endif ++ + /* let.c */ + + /* lex.c */ +--- gcl-2.6.12.orig/h/gnuwin95.h ++++ gcl-2.6.12/h/gnuwin95.h +@@ -7,15 +7,6 @@ + #define DBEGIN_TY unsigned long + extern DBEGIN_TY _dbegin; + +- +- +-/* define if there is no _cleanup, do here what needs +- to be done before calling unexec +- */ +-#define CLEANUP_CODE \ +- setbuf(stdin,0); \ +- setbuf(stdout,0); +- + /* size to use for mallocs done */ + /* #define BABY_MALLOC_SIZE 0x5000 */ + +--- gcl-2.6.12.orig/h/linux.h ++++ gcl-2.6.12/h/linux.h +@@ -130,10 +130,6 @@ do { int c = 0; \ + + #define SET_SESSION_ID() (setpgrp() ? -1 : 0) + +-#define CLEANUP_CODE \ +- setbuf(stdin,0); \ +- setbuf(stdout,0); +- + #include + #include + #define GET_FULL_PATH_SELF(a_) do {\ +--- gcl-2.6.12.orig/h/mingw.h ++++ gcl-2.6.12/h/mingw.h +@@ -47,13 +47,6 @@ + #define DBEGIN_TY unsigned int + extern DBEGIN_TY _stacktop, _stackbottom, _dbegin; + +-/* define if there is no _cleanup, do here what needs +- to be done before calling unexec +- */ +-#define CLEANUP_CODE \ +- setbuf(stdin,0); \ +- setbuf(stdout,0); +- + #define NO_SYS_PARAM_H + #define NO_SYS_TIMES_H + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1796,6 +1796,10 @@ malloc(size_t size) { + + if (!gcl_alloc_initialized) + gcl_init_alloc(&size); ++#ifdef CAN_UNRANDOMIZE_SBRK ++ else if (!gcl_unrandomized) ++ return sbrk(size); ++#endif + + CHECK_INTERRUPT; + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -412,16 +412,18 @@ DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_bl + + #define HAVE_GCL_CLEANUP + ++#ifdef CAN_UNRANDOMIZE_SBRK ++bool gcl_unrandomized=FALSE; ++#endif ++ + void + gcl_cleanup(int gc) { + + if (getenv("GCL_WAIT")) + sleep(30); + +-#ifdef CLEANUP_CODE +- CLEANUP_CODE +-#elif defined(USE_CLEANUP) +- {extern void _cleanup(void);_cleanup();} ++#if defined(USE_CLEANUP) ++ {extern void _cleanup(void);_cleanup();} + #endif + + #ifdef GCL_GPROF +@@ -440,6 +442,10 @@ gcl_cleanup(int gc) { + cs_org=0; + initial_sbrk=core_end; + ++#ifdef CAN_UNRANDOMIZE_SBRK ++ gcl_unrandomized=FALSE; ++#endif ++ + } + + close_pool(); +@@ -450,6 +456,13 @@ gcl_cleanup(int gc) { + int + main(int argc, char **argv, char **envp) { + ++#ifdef CAN_UNRANDOMIZE_SBRK ++#include ++#include ++#include "unrandomize.h" ++ gcl_unrandomized=TRUE; ++#endif ++ + gcl_init_alloc(&argv); + + #ifdef GET_FULL_PATH_SELF +@@ -465,12 +478,6 @@ main(int argc, char **argv, char **envp) + #endif + *argv=kcl_self; + +-#ifdef CAN_UNRANDOMIZE_SBRK +-#include +-#include +-#include "unrandomize.h" +-#endif +- + setbuf(stdin, stdin_buf); + setbuf(stdout, stdout_buf); + #ifdef _WIN32 diff --git a/patches/Version_2_6_13pre28 b/patches/Version_2_6_13pre28 new file mode 100644 index 00000000..563b08d5 --- /dev/null +++ b/patches/Version_2_6_13pre28 @@ -0,0 +1,353 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-23) unstable; urgency=medium + . + * Version_2_6_13pre28 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/linux.h ++++ gcl-2.6.12/h/linux.h +@@ -132,20 +132,18 @@ do { int c = 0; \ + + #include + #include +-#define GET_FULL_PATH_SELF(a_) do {\ +- char b[20];\ +- static char q[PATH_MAX];\ +- struct stat ss;\ +- if (snprintf(b,sizeof(b),"/proc/%d/exe",getpid())<=0)\ +- error("Cannot write proc exe pathname");\ +- if (stat(b,&ss)) \ +- (a_)=argv[0];\ +- else {\ +- if (!realpath(b,q)) \ +- error("realpath error");\ +- (a_)=q;\ +- }\ +-} while(0) ++#define GET_FULL_PATH_SELF(a_) do { \ ++ static char q[PATH_MAX]; \ ++ const char *s="/proc/self/exe"; \ ++ struct stat ss; \ ++ if (stat(s,&ss)) \ ++ (a_)=argv[0]; \ ++ else { \ ++ if (!realpath(s,q)) \ ++ error("realpath error"); \ ++ (a_)=q; \ ++ } \ ++ } while(0) + + + #define UC(a_) ((ucontext_t *)a_) +--- gcl-2.6.12.orig/h/unrandomize.h ++++ gcl-2.6.12/h/unrandomize.h +@@ -23,6 +23,7 @@ + int i,j,k; + char **n,**a; + void *v; ++ argv[0]="/proc/self/exe"; + for (i=j=0;argv[i];i++) + j+=strlen(argv[i])+1; + for (k=0;envp[k];k++) +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -351,7 +351,8 @@ resize_hole(ufixnum hp,enum type tp,bool + + if (!in_placep && + ((new_start<=start && starts.s_dbind != Cnil) ++ emsg("Toggling relblock when resizing hole to %lu\n",hp); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + return resize_hole(hp,tp,in_placep); +@@ -387,7 +388,8 @@ alloc_page(long n) { + d=d<0 ? 0 : d; + d=(available_pages/3)s.s_dbind != Cnil) ++ emsg("Hole overrun\n"); + + resize_hole(d+nn,t_relocatable,0); + +@@ -857,7 +859,8 @@ add_pages(struct typemanager *tm,fixnum + case t_relocatable: + + if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { +- emsg("Moving relblock low before expanding relblock pages\n"); ++ if (sSAnotify_gbcA->s.s_dbind != Cnil) ++ emsg("Moving relblock low before expanding relblock pages\n"); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } +@@ -1652,22 +1655,15 @@ DEFUN_NEW("GPROF-QUIT",object,fSgprof_qu + if (!gprof_on) + return Cnil; + +- if (!getcwd(b,sizeof(b))) +- FEerror("Cannot get working directory", 0); +- if (chdir(P_tmpdir)) +- FEerror("Cannot change directory to tmpdir", 0); ++ massert(getcwd(b,sizeof(b))); ++ massert(!chdir(P_tmpdir)); + _mcleanup(); +- if (snprintf(b1,sizeof(b1),"gprof %s",kcl_self)<=0) +- FEerror("Cannot write gprof command line", 0); +- if (!(pp=popen(b1,"r"))) +- FEerror("Cannot open gprof pipe", 0); ++ massert(snprintf(b1,sizeof(b1),"gprof %s",kcl_self)>0); ++ massert((pp=popen(b1,"r"))); + while ((n=fread(b1,1,sizeof(b1),pp))) +- if (!fwrite(b1,1,n,stdout)) +- FEerror("Cannot write gprof output",0); +- if (pclose(pp)<0) +- FEerror("Cannot close gprof pipe", 0); +- if (chdir(b)) +- FEerror("Cannot restore working directory", 0); ++ massert(fwrite(b1,1,n,stdout)); ++ massert(pclose(pp)>=0); ++ massert(!chdir(b)); + gprof_on=0; + + return Cnil; +@@ -1785,28 +1781,37 @@ static char *baby_malloc(n) + + bool writable_malloc=0; + +-void * +-malloc(size_t size) { +- +- static bool in_malloc; +- +- if (in_malloc) +- return NULL; +- in_malloc=1; ++static void * ++malloc_internal(size_t size) { + +- if (!gcl_alloc_initialized) +- gcl_init_alloc(&size); + #ifdef CAN_UNRANDOMIZE_SBRK +- else if (!gcl_unrandomized) +- return sbrk(size); ++ if (core_end && core_end!=sbrk(0))/*malloc before main in saved_image*/ ++ return sbrk(size);/*will never get to gcl_init_alloc, so brk point irrelevant*/ + #endif +- ++ if (!gcl_alloc_initialized) { ++ static bool recursive_malloc; ++ if (recursive_malloc) ++ error("Bad malloc"); ++ recursive_malloc=1; ++ gcl_init_alloc(&size); ++ recursive_malloc=0; ++ } ++ + CHECK_INTERRUPT; + + malloc_list = make_cons(alloc_simple_string(size), malloc_list); + malloc_list->c.c_car->st.st_self = alloc_contblock(size); + malloc_list->c.c_car->st.st_adjustable=writable_malloc; + ++ return(malloc_list->c.c_car->st.st_self); ++ ++} ++ ++void * ++malloc(size_t size) { ++ ++ void *v=malloc_internal(size);; ++ + /* FIXME: this is just to handle clean freeing of the + monstartup memory allocated automatically on raw image + startup. In saved images, monstartup memory is only +@@ -1814,12 +1819,11 @@ malloc(size_t size) { + #ifdef GCL_GPROF + if (raw_image && size>(textend-textstart) && !initial_monstartup_pointer) { + massert(!atexit(gprof_cleanup)); +- initial_monstartup_pointer=malloc_list->c.c_car->st.st_self; ++ initial_monstartup_pointer=v; + } + #endif + +- in_malloc=0; +- return(malloc_list->c.c_car->st.st_self); ++ return v; + + } + +--- gcl-2.6.12.orig/o/error.c ++++ gcl-2.6.12/o/error.c +@@ -35,7 +35,7 @@ object sSterminal_interrupt; + void + assert_error(const char *a,unsigned l,const char *f,const char *n) { + +- if (!raw_image) ++ if (!raw_image && core_end && core_end==sbrk(0)) + FEerror("The assertion ~a on line ~a of ~a in function ~a failed",4, + make_simple_string(a),make_fixnum(l), + make_simple_string(f),make_simple_string(n)); +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -1170,15 +1170,15 @@ GBC(enum type t) { + gc_time=0; + + #ifdef SGC +- printf("[%s for %ld %s pages..", +- (sgc_enabled ? "SGC" : "GC"), +- (sgc_enabled ? sgc_count_type(t) : tm_of(t)->tm_npage), +- (tm_table[(int)t].tm_name)+1); ++ emsg("[%s for %ld %s pages..", ++ (sgc_enabled ? "SGC" : "GC"), ++ (sgc_enabled ? sgc_count_type(t) : tm_of(t)->tm_npage), ++ (tm_table[(int)t].tm_name)+1); + #else +- printf("[%s for %ld %s pages..", +- ("GC"), +- (tm_of(t)->tm_npage), +- (tm_table[(int)t].tm_name)+1); ++ emsg("[%s for %ld %s pages..", ++ ("GC"), ++ (tm_of(t)->tm_npage), ++ (tm_table[(int)t].tm_name)+1); + #endif + + #ifdef SGC +@@ -1349,10 +1349,9 @@ GBC(enum type t) { + if (sSAnotify_gbcA->s.s_dbind != Cnil) { + + if (gc_recursive) +- fprintf(stdout, "(T=...).GC finished]\n"); ++ emsg("(T=...).GC finished]\n"); + else +- fprintf(stdout, "(T=%d).GC finished]\n",gc_start); +- fflush(stdout); ++ emsg("(T=%d).GC finished]\n",gc_start); + + } + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -205,21 +205,21 @@ get_proc_meminfo_value_in_pages(const ch + return n>>(PAGEWIDTH-10); + } + ++#include ++ + static ufixnum + get_phys_pages_no_malloc(char freep) { + +- return freep ? +- get_proc_meminfo_value_in_pages("MemFree:")+ +- get_proc_meminfo_value_in_pages("Buffers:")+ +- get_proc_meminfo_value_in_pages("Cached:") : +- get_proc_meminfo_value_in_pages("MemTotal:"); ++ struct sysinfo s; ++ sysinfo(&s); ++ return (freep ? s.freeram : s.totalram)>>PAGEWIDTH; + + } + + #endif + + static ufixnum +-get_phys_pages(char freep) { ++get_phys_pages1(char freep) { + + return get_phys_pages_no_malloc(freep); + +@@ -313,7 +313,7 @@ update_real_maxpage(void) { + } + massert(!mbrk(cur)); + +- phys_pages=ufmin(get_phys_pages(0)+page(beg),real_maxpage)-page(beg); ++ phys_pages=ufmin(get_phys_pages1(0)+page(beg),real_maxpage)-page(beg); + + get_gc_environ(); + setup_maxpages(mem_multiple); +@@ -412,10 +412,6 @@ DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_bl + + #define HAVE_GCL_CLEANUP + +-#ifdef CAN_UNRANDOMIZE_SBRK +-bool gcl_unrandomized=FALSE; +-#endif +- + void + gcl_cleanup(int gc) { + +@@ -442,10 +438,6 @@ gcl_cleanup(int gc) { + cs_org=0; + initial_sbrk=core_end; + +-#ifdef CAN_UNRANDOMIZE_SBRK +- gcl_unrandomized=FALSE; +-#endif +- + } + + close_pool(); +@@ -460,7 +452,6 @@ main(int argc, char **argv, char **envp) + #include + #include + #include "unrandomize.h" +- gcl_unrandomized=TRUE; + #endif + + gcl_init_alloc(&argv); +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -181,8 +181,7 @@ relocate(Sym *sym1,void *v,ul a,ul start + #include RELOC_H + + default: +- emsg("Unknown reloc type %lu\n", tp); +- massert(tp&~tp); ++ massert(!emsg("Unknown reloc type %lu\n", tp)); + + } + +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -789,10 +789,8 @@ sgc_start(void) { + sgc_enabled=1; + if (memory_protect(1)) + sgc_quit(); +- if (sSAnotify_gbcA->s.s_dbind != Cnil) { +- printf("[SGC on]"); +- fflush(stdout); +- } ++ if (sSAnotify_gbcA->s.s_dbind != Cnil) ++ emsg("[SGC on]"); + + sSAoptimize_maximum_pagesA->s.s_dbind=omp; + +@@ -826,7 +824,7 @@ sgc_quit(void) { + memory_protect(0); + + if(sSAnotify_gbcA->s.s_dbind != Cnil) +- printf("[SGC off]"); fflush(stdout); ++ emsg("[SGC off]"); + + if (sgc_enabled==0) + return 0; diff --git a/patches/Version_2_6_13pre29 b/patches/Version_2_6_13pre29 new file mode 100644 index 00000000..9752a187 --- /dev/null +++ b/patches/Version_2_6_13pre29 @@ -0,0 +1,47 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-23) unstable; urgency=medium + . + * Version_2_6_13pre28 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1203,8 +1203,8 @@ object malloc_list=Cnil; + + void + maybe_set_hole_from_maxpages(void) { +- if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) +- resize_hole(available_pages/3,t_relocatable,0); ++ if (rb_pointer==rb_begin()) ++ resize_hole(ufmin(phys_pages,available_pages/3),t_relocatable,0); + } + + void +@@ -1358,7 +1358,7 @@ gcl_init_alloc(void *cs_start) { + set_tm_maxpage(tm_table+t_relocatable,1); + nrbpage=0; + +- resize_hole(ufmin(phys_pages,available_pages/3),t_relocatable,0); ++ maybe_set_hole_from_maxpages(); + #ifdef SGC + tm_table[(int)t_relocatable].tm_sgc = 50; + #endif diff --git a/patches/Version_2_6_13pre3 b/patches/Version_2_6_13pre3 new file mode 100644 index 00000000..e3360795 --- /dev/null +++ b/patches/Version_2_6_13pre3 @@ -0,0 +1,124 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-3) unstable; urgency=medium + . + * Version_2_6_13pre2 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1938,3 +1938,6 @@ check_avail_pages(void); + + inline int + mbrk(void *); ++ ++void ++maybe_set_hole_from_maxpages(void); +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -259,19 +259,15 @@ eg to add 20 more do (si::set-hole-size + + holepage -= nn; + heap_end=v; +- return e; + ++ } else if (v>(void *)core_end) { ++ ++ massert(!mbrk(v)); ++ core_end=v; ++ + } +- +- if (nn<=(core_end-heap_end)/PAGESIZE) +- return(heap_end); +- +- if (mbrk(v)) +- error("Can't allocate. Good-bye!"); +- +- core_end=v; +- +- return(heap_end); ++ ++ return(e); + + } + +@@ -1177,6 +1173,15 @@ object malloc_list=Cnil; + #include + + void ++maybe_set_hole_from_maxpages(void) { ++ if (rb_start==heap_end && rb_end==rb_start && rb_limit==rb_start && rb_pointer==rb_start) { ++ holepage=new_holepage; ++ alloc_page(-holepage); ++ rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<s.s_fillp = i; + sym->s.s_self = alloc_relblock(i); ++ sym->s.s_fillp = i; + i=this_gensym_prefix->st.st_fillp; + for (j = 0; j < i; j++) + sym->s.s_self[j] = this_gensym_prefix->st.st_self[j]; +--- gcl-2.6.12.orig/pcl/makefile ++++ gcl-2.6.12/pcl/makefile +@@ -17,6 +17,7 @@ SETUP='(load "defsys.lisp")' \ + '(setq compiler::*default-c-file* t)'\ + '(setq compiler::*default-data-file* t)'\ + '(setq compiler::*default-system-p* t)' \ ++ '(setq si::*code-block-reserve* (make-array 10000000 :element-type (quote character) :static t) a nil)' \ + '(setq compiler::*keep-gaz* t compiler::*tmp-dir* "")' + + all: $(addsuffix .c,$(AFILES)) $(addsuffix .o,$(AFILES)) diff --git a/patches/Version_2_6_13pre30 b/patches/Version_2_6_13pre30 new file mode 100644 index 00000000..20b2b33f --- /dev/null +++ b/patches/Version_2_6_13pre30 @@ -0,0 +1,111 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-23) unstable; urgency=medium + . + * Version_2_6_13pre29 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4435,6 +4435,10 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) ++ case $canonical in ++ mips64*linux*) ++ TLIBS="$TLIBS -Wl,-z -Wl,now";; ++ esac + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -640,6 +640,10 @@ case $use in + # if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi + ;; + mips*) ++ case $canonical in ++ mips64*linux*) ++ TLIBS="$TLIBS -Wl,-z -Wl,now";; ++ esac + # if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 + ;; + ia64*) +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -6,18 +6,28 @@ static ul ggot,ggote; static Rela *hr; + #define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : ((a_>>56)&0xff)) + #define ELF_R_FTYPE(a_) ((a_>>56)&0xff) + ++typedef struct { ++ ul entry,gotoff; ++ unsigned int ld_gotoff,lw,jr,lwcan; ++} call_16_tramp; ++ + static int + write_stub(ul s,ul *got,ul *gote) { + +- int *goti; +- +- *gote=(ul)(goti=(void *)(gote+2)); +- *++gote=s; +- s=((void *)gote-(void *)got); +- *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s; +- *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0; +- *goti++=0x03200008; +- *goti++=0x00200825; ++ static call_16_tramp t1={0,0, ++ (0x37<<26)|(0x1c<<21)|(0x19<<16), /*ld t9,(0)gp*/ ++ (0x37<<26)|(0x19<<21)|(0x19<<16), /*ld t9,(0)t9*/ ++ 0x03200008, /*jr t9*/ ++ 0 /*nop*/ ++ }; ++ call_16_tramp *t=(void *)gote; ++ ++ *t=t1; ++ *got=can_gp; ++ ++ t->entry=(ul)(gote+2); ++ t->gotoff=s; ++ t->ld_gotoff|=((void *)(gote+1)-(void *)got); + + return 0; + +@@ -31,7 +41,7 @@ make_got_room_for_stub(Shdr *sec1,Shdr * + if ((ssec>=sece || !ALLOC_SEC(ssec)) && + (a=find_sym_ptable(st1+sym->st_name)) && + a->address>=ggot && a->address>PAGEWIDTH; ++ return ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit; + + } + diff --git a/patches/Version_2_6_13pre31 b/patches/Version_2_6_13pre31 new file mode 100644 index 00000000..4ec9d79b --- /dev/null +++ b/patches/Version_2_6_13pre31 @@ -0,0 +1,115 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-24) unstable; urgency=medium + . + * Version_2_6_13pre30 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/386-kfreebsd.h ++++ gcl-2.6.12/h/386-kfreebsd.h +@@ -46,3 +46,4 @@ + #define RELOC_H "elf32_i386_reloc.h" + + #define BRK_DOES_NOT_GUARANTEE_ALLOCATION ++#define FREEBSD +--- gcl-2.6.12.orig/h/amd64-kfreebsd.h ++++ gcl-2.6.12/h/amd64-kfreebsd.h +@@ -23,3 +23,4 @@ + #define RELOC_H "elf64_i386_reloc.h" + + #define BRK_DOES_NOT_GUARANTEE_ALLOCATION ++#define FREEBSD +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -23,7 +23,6 @@ write_stub(ul s,ul *got,ul *gote) { + call_16_tramp *t=(void *)gote; + + *t=t1; +- *got=can_gp; + + t->entry=(ul)(gote+2); + t->gotoff=s; +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -152,6 +152,7 @@ mbrk(void *v) { + + static ufixnum + get_phys_pages_no_malloc(char n) { ++ + MEMORYSTATUS m; + + m.dwLength=sizeof(m); +@@ -166,6 +167,7 @@ get_phys_pages_no_malloc(char n) { + + static ufixnum + get_phys_pages_no_malloc(char n) { ++ + uint64_t s; + size_t z=sizeof(s); + int m[2]={CTL_HW,HW_MEMSIZE}; +@@ -186,33 +188,30 @@ get_phys_pages_no_malloc(char n) { + + } + +-#else ++#elif defined(FREEBSD) ++ ++#include ++#include ++ ++static ufixnum ++get_phys_pages_no_malloc(char n) { ++ ++ size_t i,len=sizeof(i); + +-ufixnum +-get_proc_meminfo_value_in_pages(const char *k) { +- int l,m; +- char b[PAGESIZE],*c; +- ufixnum n; ++ return (sysctlbyname("hw.physmem",&i,&len,NULL,0) ? 0 : i)>>PAGEWIDTH; + +- massert((l=open("/proc/meminfo",O_RDONLY))!=-1); +- massert((n=read(l,b,sizeof(b)))>(PAGEWIDTH-10); + } + ++#else /*Linux*/ ++ + #include + + static ufixnum + get_phys_pages_no_malloc(char freep) { + + struct sysinfo s; +- sysinfo(&s); +- return ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit; ++ ++ return sysinfo(&s) ? 0 : ((freep ? s.freeram : s.totalram)>>PAGEWIDTH)*s.mem_unit; + + } + diff --git a/patches/Version_2_6_13pre32 b/patches/Version_2_6_13pre32 new file mode 100644 index 00000000..4c42fbf6 --- /dev/null +++ b/patches/Version_2_6_13pre32 @@ -0,0 +1,57 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-25) unstable; urgency=medium + . + * Version_2_6_13pre31, kfreebsd and mips64 FTBFS fix +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/elf64_mips_reloc.h ++++ gcl-2.6.12/h/elf64_mips_reloc.h +@@ -1,6 +1,7 @@ + case R_MIPS_JALR: + break; + case R_MIPS_64: ++ if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL32) s-=(ul)got; + add_val(where,~0L,s+a); + break; + case R_MIPS_GPREL32: +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -3,7 +3,7 @@ static ul ggot,ggote; static Rela *hr; + #undef ELF_R_SYM + #define ELF_R_SYM(a_) (a_&0xffffffff) + #undef ELF_R_TYPE +-#define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : ((a_>>56)&0xff)) ++#define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : (((a_>>48)&0xff) ? ((a_>>48)&0xff) : ((a_>>56)&0xff))) + #define ELF_R_FTYPE(a_) ((a_>>56)&0xff) + + typedef struct { +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -179,7 +179,7 @@ get_phys_pages_no_malloc(char n) { + + } + +-#elif defined(__sun__) ++#elif defined(__sun__) || defined(__GNU__) + + static ufixnum + get_phys_pages_no_malloc(char n) { diff --git a/patches/Version_2_6_13pre33 b/patches/Version_2_6_13pre33 new file mode 100644 index 00000000..3f918464 --- /dev/null +++ b/patches/Version_2_6_13pre33 @@ -0,0 +1,232 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-26) unstable; urgency=medium + . + * Version_2_6_13pre32 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -161,7 +161,7 @@ + + + (defun compile-file1 (input-pathname +- &key (output-file input-pathname) ++ &key (output-file (truename input-pathname)) + (o-file t) + (c-file *default-c-file*) + (h-file *default-h-file*) +--- gcl-2.6.12.orig/h/elf64_mips_reloc.h ++++ gcl-2.6.12/h/elf64_mips_reloc.h +@@ -1,18 +1,28 @@ + case R_MIPS_JALR: + break; +- case R_MIPS_64: +- if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL32) s-=(ul)got; +- add_val(where,~0L,s+a); +- break; + case R_MIPS_GPREL32: ++ recurse(s+a-(ul)got); + add_val(where,MASK(32),s+a-(ul)got); + break; ++ case R_MIPS_GPREL16: ++ recurse(s+a-(ul)got); ++ add_val(where,MASK(16),s+a-(ul)got); ++ break; ++ case R_MIPS_SUB: ++ recurse(-(s+a)); ++ break;/*???*/ ++ case R_MIPS_64: ++ recurse(s+a); ++ add_val(where,~0L,s+a); ++ break; + case R_MIPS_32: ++ recurse(s+a); + add_val(where,MASK(32),s+a); + break; + case R_MIPS_GOT_DISP: + case R_MIPS_CALL16: + case R_MIPS_GOT_PAGE: ++ recurse(s+a); + gote=got+(a>>32)-1; + a&=MASK(32); + store_val(where,MASK(16),((void *)gote-(void *)got)); +@@ -22,28 +32,27 @@ + *gote=s+(a&~MASK(16))+((a&0x8000)<<1); + break; + case R_MIPS_GOT_OFST: ++ recurse(s+a); + store_val(where,MASK(16),a); + break; + case R_MIPS_HI16: +- s+=a&MASK(32); +- if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL16) s=(ul)got-s; ++ recurse(s+a); + if (!hr) hr=(void *)r; +- if (a&(1L<<32)) add_vals(where,MASK(16),(s+(a>>32))>>16); ++ if (lr)/*==(Rela *)r*/ ++ add_vals(where,MASK(16),(s+a+la)>>16); + break; + case R_MIPS_LO16: ++ recurse(s+a); + s+=a; +- if (ELF_R_FTYPE(r->r_info)==R_MIPS_GPREL16) s=(ul)got-s; + a=*where&MASK(16); + if (a&0x8000) a|=0xffffffffffff0000; + a+=s&MASK(16); + a+=(a&0x8000)<<1; + store_val(where,MASK(16),a); +- a&=~MASK(16); +- { +- Rela *ra=(void *)r; +- for (hr=hr ? hr : (void *)ra;--ra>=hr;) +- if (ELF_R_TYPE(ra->r_info)==R_MIPS_HI16) +- relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote); +- } +- hr=NULL; ++ for (la=a&~MASK(16),lr=(Rela *)r,hr=hr ? hr : lr;--lr>=hr;) ++ if (ELF_R_TYPE1(lr->r_info)==R_MIPS_HI16|| ++ ELF_R_TYPE2(lr->r_info)==R_MIPS_HI16|| ++ ELF_R_TYPE3(lr->r_info)==R_MIPS_HI16) ++ relocate(sym1,lr,lr->r_addend,start,got,gote); ++ hr=lr=NULL; + break; +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -1,10 +1,21 @@ +-static ul ggot,ggote; static Rela *hr; ++static ul ggot,ggote,la; static Rela *hr,*lr; + + #undef ELF_R_SYM + #define ELF_R_SYM(a_) (a_&0xffffffff) ++#define ELF_R_TYPE1(a_) ((a_>>56)&0xff) ++#define ELF_R_TYPE2(a_) ((a_>>48)&0xff) ++#define ELF_R_TYPE3(a_) ((a_>>40)&0xff) ++#define recurse(val) ({ \ ++ if (ELF_R_TYPE2(r->r_info)) { \ ++ ul i=r->r_info; \ ++ r->r_info=(((r->r_info>>32)&MASK(24))<<40)|(r->r_info&MASK(32)); \ ++ relocate(sym1,r,(val)-s,start,got,gote); \ ++ r->r_info=i; \ ++ break; \ ++ }}) ++ + #undef ELF_R_TYPE +-#define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : (((a_>>48)&0xff) ? ((a_>>48)&0xff) : ((a_>>56)&0xff))) +-#define ELF_R_FTYPE(a_) ((a_>>56)&0xff) ++#define ELF_R_TYPE(a_) ELF_R_TYPE1(a_) + + typedef struct { + ul entry,gotoff; +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -568,6 +568,12 @@ EXTER unsigned plong signals_allowed, si + + #define IMMNIL(x) (is_imm_fixnum(x)||x==Cnil) + +-#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&eql1(_a,_b));}) +-#define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&equal1(_a,_b));}) +-#define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (_a!=Cnil&&_b!=Cnil&&equalp1(_a,_b));}) ++/*gcc boolean expression tail position bug*/ ++ ++/* #define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&eql1(_a,_b));}) */ ++/* #define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&equal1(_a,_b));}) */ ++/* #define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (_a!=Cnil&&_b!=Cnil&&equalp1(_a,_b));}) */ ++ ++#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : eql1(_a,_b));}) ++#define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : equal1(_a,_b));}) ++#define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (_a==Cnil||_b==Cnil ? FALSE : equalp1(_a,_b));}) +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -443,6 +443,23 @@ gcl_cleanup(int gc) { + + } + ++/*gcc boolean expression tail position bug*/ ++ ++void * ++cclear_stack(unsigned long size) { ++ void *v=alloca(size); ++ memset(v,0,size); ++ return v; ++} ++ ++DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",object,fSequal_tail_recursion_check,SI,1,1,NONE,II,OO,OO,OO,(fixnum s),"") { ++ object x0=make_list(s/sizeof(object)),x1=make_list(s/sizeof(object)); ++ char *u=cclear_stack(s),*w; ++ fLequal(x0,x1); ++ for (w=u;wc.c_car,y->c.c_car)) { +- x=x->c.c_cdr; +- y=y->c.c_cdr; +- if (x==y) return TRUE; +- if (IMMNIL(x)||IMMNIL(y)) return FALSE; +- goto BEGIN; +- } else +- return FALSE; +- } +-#else +- +- if (valid_cdr(x)) return valid_cdr(y)&&equal(x->c.c_car,y->c.c_car)&&equal(x->c.c_cdr,y->c.c_cdr); +- +-#endif ++ /*gcc boolean expression tail position bug*/ ++ /* if (valid_cdr(x)) return valid_cdr(y)&&equal(x->c.c_car,y->c.c_car)&&equal(x->c.c_cdr,y->c.c_cdr); */ ++ if (valid_cdr(x)) return !valid_cdr(y)||!equal(x->c.c_car,y->c.c_car) ? FALSE : equal(x->c.c_cdr,y->c.c_cdr); + + if (valid_cdr(y)) return FALSE; + +@@ -524,7 +510,9 @@ equalp1(register object x, register obje + + /*x and y are not == and not Cnil*/ + +- if (listp(x)) return listp(y)&&equalp(x->c.c_car,y->c.c_car)&&equalp(x->c.c_cdr,y->c.c_cdr); ++ /*gcc boolean expression tail position bug*/ ++ /* if (listp(x)) return listp(y)&&equalp(x->c.c_car,y->c.c_car)&&equalp(x->c.c_cdr,y->c.c_cdr); */ ++ if (listp(x)) return !listp(y)||!equalp(x->c.c_car,y->c.c_car) ? FALSE : equalp(x->c.c_cdr,y->c.c_cdr); + + if (listp(y)) return FALSE; + +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -79,3 +79,7 @@ + + #+ansi-cl (use-package :pcl :user) + #+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) ++ ++(let* ((i 4096)(j (si::equal-tail-recursion-check i))) ++ (unless (eql i j) ++ (warn "equal is not tail recursive ~s ~s" i j))) diff --git a/patches/Version_2_6_13pre34 b/patches/Version_2_6_13pre34 new file mode 100644 index 00000000..15aa00d9 --- /dev/null +++ b/patches/Version_2_6_13pre34 @@ -0,0 +1,34 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-27) unstable; urgency=medium + . + * Version_2_6_13pre33; mips64 relocs; stack saving tail-recursive equal. +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -81,5 +81,5 @@ + #+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) + + (let* ((i 4096)(j (si::equal-tail-recursion-check i))) +- (unless (eql i j) ++ (unless (<= (ash i -1) j) + (warn "equal is not tail recursive ~s ~s" i j))) diff --git a/patches/Version_2_6_13pre35 b/patches/Version_2_6_13pre35 new file mode 100644 index 00000000..90ea7eae --- /dev/null +++ b/patches/Version_2_6_13pre35 @@ -0,0 +1,40 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-27) unstable; urgency=medium + . + * Version_2_6_13pre34; mips64 relocs; stack saving tail-recursive equal. +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/predicate.c ++++ gcl-2.6.12/o/predicate.c +@@ -501,6 +501,12 @@ oequal(object x,object y) { + DEFUN_NEW("EQUAL",object,fLequal,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") { + RETURN1(equal(x0, x1) ? Ct : Cnil); + } ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fLequal(object x,object y) { ++ return FFN(fLequal)(x,y); ++} ++#endif + + bool + equalp1(register object x, register object y) { diff --git a/patches/Version_2_6_13pre36 b/patches/Version_2_6_13pre36 new file mode 100644 index 00000000..ac9a53ca --- /dev/null +++ b/patches/Version_2_6_13pre36 @@ -0,0 +1,89 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-28) unstable; urgency=medium + . + * Version_2_6_13pre35; restore hppa build +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -34,7 +34,7 @@ boot.o: boot.c $(DECL) boot.h + $(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) + + prelink.o: prelink.c $(DECL) +- $(CC) -fPIE -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) ++ $(CC) -fPIE -c $(filter-out -pg,$(CFLAGS)) $(DEFS) $*.c $(AUX_INFO) + + %.o: %.c $(DECL) + $(CC) -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) +--- gcl-2.6.12.orig/o/sfasli.c ++++ gcl-2.6.12/o/sfasli.c +@@ -111,46 +111,17 @@ LFD(build_symbol_table)(void) { + + } + +-extern int mcount(); +-extern int _mcount(); +-extern int __divdi3(); +-extern int __moddi3(); +-extern int __udivdi3(); +-extern int __umoddi3(); +-extern void sincos(double,double *,double *); +-extern int __divsi3(); +-extern int __modsi3(); +-extern int __udivsi3(); +-extern int __umodsi3(); +-extern int $$divI(); +-extern int $$divU(); +-extern int $$remI(); +-extern int $$remU(); +-extern int __divq(); +-extern int __divqu(); +-extern int __remq(); +-extern int __remqu(); +- +-#ifndef DARWIN + #ifndef _WIN32 + int + use_symbols(double d,...) { + +- sincos(d,&d,&d); +- +-#ifdef GCL_GPROF +- _mcount(); +-#endif +- +- return (int)d; ++#ifndef DARWIN ++ extern void sincos(double,double *,double *); + +-} +-#endif ++ sincos(d,&d,&d); + #else +-int +-use_symbols(double d,...) { +- + d=sin(d)+cos(d); ++#endif + + return (int)d; + diff --git a/patches/Version_2_6_13pre38 b/patches/Version_2_6_13pre38 new file mode 100644 index 00000000..7feda75d --- /dev/null +++ b/patches/Version_2_6_13pre38 @@ -0,0 +1,308 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-29) unstable; urgency=medium + . + * Version_2_6_13pre35; support latest binutils + * Bug fix: "gcl ftbfs on amd64 and i386 with binutils from + experimental", thanks to Matthias Klose (Closes: #803214). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/803214 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpvs.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpvs.lsp +@@ -75,8 +75,8 @@ + (defun wt-vs* (vs) + (wt "(" )(wt-vs vs) (wt "->c.c_car)")) + +-(defun wt-ccb-vs (ccb-vs) +- (wt "(fun->cc.cc_turbo[" (- *initial-ccb-vs* ccb-vs) "]->c.c_car)")) ++(defun wt-ccb-vs (ccb-vs);;FIXME harmonize *closure-p* with *clink* ++ (wt "(" (if *closure-p* "fun->cc.cc_turbo" "base0") "[" (- *initial-ccb-vs* ccb-vs) "]->c.c_car)")) + + (defun clink (vs) (setq *clink* vs)) + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -7663,7 +7663,7 @@ fi + if test "${enable_ansi+set}" = set; then : + enableval=$enable_ansi; + else +- enable_ansi="no" ++ enable_ansi="yes" + fi + + +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -2133,7 +2133,7 @@ AC_ARG_ENABLE(readline, + + # ansi lisp + AC_ARG_ENABLE(ansi,[--enable-ansi builds a large gcl aiming for ansi compliance, +- --disable-ansi builds the smaller traditional CLtL1 image],,enable_ansi="no") ++ --disable-ansi builds the smaller traditional CLtL1 image],,enable_ansi="yes") + + if test "$enable_ansi" = "yes" ; then + SYSTEM=ansi_gcl +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1241,7 +1241,7 @@ gcl_init_alloc(void *cs_start) { + + massert(!getrlimit(RLIMIT_STACK, &rl)); + if (rl.rlim_cur!=RLIM_INFINITY && (rl.rlim_max == RLIM_INFINITY || rl.rlim_max > rl.rlim_cur)) { +- rl.rlim_cur = rl.rlim_max == RLIM_INFINITY ? rl.rlim_max : rl.rlim_max/64; ++ rl.rlim_cur = rl.rlim_max; + massert(!setrlimit(RLIMIT_STACK,&rl)); + } + cssize = rl.rlim_cur/sizeof(*cs_org) - sizeof(*cs_org)*CSGETA; +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -2407,17 +2407,18 @@ object x=Cnil; + inPort = (myport == Cnil ? 0 : fix(Iis_fixnum(myport))); + + #ifdef BSD ++ + if (isServer && daemon != Cnil) { + + long pid,i; + struct rlimit r; +- struct sigaction sa; ++ struct sigaction sa,osa; + + sa.sa_handler=SIG_IGN; + sa.sa_flags=SA_NOCLDWAIT; + sigemptyset(&sa.sa_mask); + +- sigaction(SIGCHLD,&sa,NULL); ++ massert(!sigaction(SIGCHLD,&sa,&osa)); + + switch((pid=pfork())) { + case -1: +@@ -2425,8 +2426,7 @@ object x=Cnil; + break; + case 0: + +- if (setsid()<0) +- FEerror("setsid error", 0); ++ massert(setsid()>=0); + + if (daemon == sKpersistent) + switch(pfork()) { +@@ -2440,23 +2440,17 @@ object x=Cnil; + break; + } + ++ massert(!chdir("/")); ++ + memset(&r,0,sizeof(r)); +- if (getrlimit(RLIMIT_NOFILE,&r)) +- FEerror("Cannot get resourse usage",0); ++ massert(!getrlimit(RLIMIT_NOFILE,&r)); + + for (i=0;i=0); ++ massert((i=dup(i))>=0); ++ massert((i=dup(i))>=0); + + umask(0); + +@@ -2473,16 +2467,14 @@ object x=Cnil; + + FD_ZERO(&fds); + FD_SET(fd,&fds); +- i=select(fd+1,&fds,NULL,NULL,NULL); + +- if (i>0) { ++ if (select(fd+1,&fds,NULL,NULL,NULL)>0) { + + y=maccept(x); + +- sigaction(SIGCHLD,&sa,NULL); +- + switch((pid=pfork())) { + case 0: ++ massert(!sigaction(SIGCHLD,&osa,NULL)); + ifuncall1(server,y); + exit(0); + break; +@@ -2506,6 +2498,8 @@ object x=Cnil; + break; + } + ++ massert(!sigaction(SIGCHLD,&osa,NULL)); ++ + } else + + #endif +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -227,9 +227,9 @@ get_phys_pages1(char freep) { + static void + get_gc_environ(void) { + +- const char *e;; ++ const char *e; + +- mem_multiple=1.0; ++ mem_multiple=0.85; + if ((e=getenv("GCL_MEM_MULTIPLE"))) { + massert(sscanf(e,"%lf",&mem_multiple)==1); + massert(mem_multiple>=0.0); +--- gcl-2.6.12.orig/o/nsocket.c ++++ gcl-2.6.12/o/nsocket.c +@@ -630,50 +630,43 @@ doReverse(char *s, int n) + of the buffer may be changed. + */ + int +-getCharGclSocket(object strm, object block) +-{ +- object bufp = SOCKET_STREAM_BUFFER(strm); +- if (bufp->ust.ust_fillp > 0) { +- dprintf("getchar returns (%c)\n",bufp->ust.ust_self[-1+(bufp->ust.ust_fillp)]); ++getCharGclSocket(object strm, object block) { ++ ++ object bufp=SOCKET_STREAM_BUFFER(strm); ++ int fd=SOCKET_STREAM_FD(strm); ++ ++ if (bufp->ust.ust_fillp > 0) + return bufp->ust.ust_self[--(bufp->ust.ust_fillp)]; +- } +- else { ++ ++ if (fd>=0) { ++ + fd_set readfds; +- struct timeval timeout; +- int fd = SOCKET_STREAM_FD(strm); +- if (1) +- { int high; +- AGAIN: +- /* under cygwin a too large timout like (1<<30) does not work */ +- timeout.tv_sec = 0; +- timeout.tv_usec = 10000; +- FD_ZERO(&readfds); +- FD_SET(fd,&readfds); +- high = select(fd+1,&readfds,NULL,NULL,block==Ct ? NULL : &timeout); +- if (high > 0) +- { object bufp = SOCKET_STREAM_BUFFER(strm); +- int n; +- n = SAFE_READ(fd,bufp->st.st_self ,bufp->ust.ust_dim); ++ struct timeval t,t1={0,10000},*tp=block==Ct ? NULL : &t; ++ int high,n; ++ ++ FD_ZERO(&readfds); ++ FD_SET(fd,&readfds); ++ ++ for (;(errno=0,t=t1,high=select(fd+1,&readfds,NULL,NULL,tp))==-1 && !tp && errno==EINTR;); ++ ++ if (high > 0) { ++ ++ massert((n=SAFE_READ(fd,bufp->st.st_self,bufp->ust.ust_dim))>=0); ++ ++ if (n) { + doReverse(bufp->st.st_self,n); + bufp->ust.ust_fillp=n; +- if (n > 0) +- { +- dprintf("getchar returns (%c)\n",bufp->ust.ust_self[-1+(bufp->ust.ust_fillp)]); +- return bufp->ust.ust_self[--(bufp->ust.ust_fillp)]; +- } +- else +- { +- SOCKET_STREAM_FD(strm)=-1; +- return EOF; +- FEerror("select said there was stuff there but there was not",0); +- } +- } +- /* probably a signal interrupted us.. */ +- if (block == Ct) +- goto AGAIN; +- return EOF; +- } ++ } else ++ SOCKET_STREAM_FD(strm)=-1; ++ ++ return getCharGclSocket(strm,block); ++ ++ } ++ + } ++ ++ return EOF; ++ + } + + #else +--- gcl-2.6.12.orig/o/prelink.c ++++ gcl-2.6.12/o/prelink.c +@@ -7,6 +7,7 @@ extern FILE *stdin __attribute__((weak)) + extern FILE *stderr __attribute__((weak)); + extern FILE *stdout __attribute__((weak)); + ++#ifdef HAVE_READLINE + #if RL_READLINE_VERSION < 0x0600 + extern Function *rl_completion_entry_function __attribute__((weak)); + extern char *rl_readline_name __attribute__((weak)); +@@ -15,6 +16,7 @@ extern rl_compentry_func_t *rl_completio + extern const char *rl_readline_name __attribute__((weak)); + #endif + #endif ++#endif + + void + prelink_init(void) { +--- gcl-2.6.12.orig/o/sfasli.c ++++ gcl-2.6.12/o/sfasli.c +@@ -116,14 +116,20 @@ int + use_symbols(double d,...) { + + #ifndef DARWIN ++ + extern void sincos(double,double *,double *); ++ double d2; ++ ++ sincos(d,&d,&d2); + +- sincos(d,&d,&d); + #else ++ + d=sin(d)+cos(d); ++ d2=sin(d)+cos(d); ++ + #endif + +- return (int)d; ++ return (int)(d+d2); + + } + #endif diff --git a/patches/Version_2_6_13pre39 b/patches/Version_2_6_13pre39 new file mode 100644 index 00000000..5ffdcd04 --- /dev/null +++ b/patches/Version_2_6_13pre39 @@ -0,0 +1,53 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-30) unstable; urgency=medium + . + * Version_2_6_13pre38 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4379,7 +4379,10 @@ $as_echo "Reducing optimization on profi + enable_debug=yes;; + esac + TCFLAGS="$TCFLAGS -pg"; +- TLIBS="$TLIBS -pg"; ++ case $use in ++ s390*) ;; # relocation truncation bug in gcc ++ *) TLIBS="$TLIBS -pg";; ++ esac + TFPFLAG="" + + $as_echo "#define GCL_GPROF 1" >>confdefs.h +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -587,7 +587,10 @@ if test "$enable_gprof" = "yes" ; then + enable_debug=yes;; + esac + TCFLAGS="$TCFLAGS -pg"; +- TLIBS="$TLIBS -pg"; ++ case $use in ++ s390*) ;; # relocation truncation bug in gcc ++ *) TLIBS="$TLIBS -pg";; ++ esac + TFPFLAG="" + AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) + else diff --git a/patches/Version_2_6_13pre3a b/patches/Version_2_6_13pre3a new file mode 100644 index 00000000..db3902c5 --- /dev/null +++ b/patches/Version_2_6_13pre3a @@ -0,0 +1,62 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-4) unstable; urgency=medium + . + * Version_2_6_13pre3 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/bsd.h ++++ gcl-2.6.12/h/bsd.h +@@ -33,7 +33,7 @@ filecpy(save, original, stsize - sizeof( + + extern char etext; + +-#define INIT_ALLOC heap_end = core_end = sbrk(0); ++#define INIT_ALLOC heap_end = core_end = PCEI(sbrk(0),PAGESIZE); + + #define SYM_EXTERNAL_P(sym) ((sym)->n_type & N_EXT) + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -229,9 +229,7 @@ alloc_page(long n) { + + if (!s) { + +- if (nn>(holepage - (in_signal_handler? 0 : +- available_pages-n<=reserve_pages_for_signal_handler ? 0 : +- reserve_pages_for_signal_handler))) { ++ if (nn>holepage) { + + + fixnum d=available_pages-nn; +@@ -241,12 +239,6 @@ alloc_page(long n) { + d=d<0 ? 0 : d; + d=new_holepage + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-4) unstable; urgency=medium + . + * Version_2_6_13pre3a +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h +@@ -15,8 +15,6 @@ find_special_params(void *v,Shdr *sec1,S + Shdr *sec; + Rela *r; + void *ve; +- ul j,*u; +- + + massert((sec=get_section(".rela.plt",sec1,sece,sn))); + +--- gcl-2.6.12.orig/h/page.h ++++ gcl-2.6.12/h/page.h +@@ -88,7 +88,8 @@ extern int reserve_pages_for_signal_hand + /* #define CONT_MARK_PAGE (((page(heap_end)-first_data_page)*(PAGESIZE/(CPTR_SIZE*CHAR_SIZE))+PAGESIZE-1)/PAGESIZE) */ + /* #define available_pages ((fixnum)(real_maxpage-page(heap_end)-2*nrbpage-CONT_MARK_PAGE-resv_pages)) */ + +-extern struct pageinfo *cell_list_head,*cell_list_tail,*contblock_list_head,*contblock_list_tail; ++extern struct pageinfo *cell_list_head,*cell_list_tail/* ,*contblock_list_head,*contblock_list_tail */; ++extern object contblock_array; + + #define PAGE_MAGIC 0x2e + +@@ -114,7 +115,7 @@ EXTER void *data_start,*initial_sbrk; + #define CB_BITS CPTR_SIZE*CHAR_SIZE + #define ceil(a_,b_) (((a_)+(b_)-1)/(b_)) + #define npage(m_) ceil(m_,PAGESIZE) +-#define cpage(m_) ({ufixnum _m=(m_);ceil(sizeof(struct pageinfo)+_m+2*ceil(_m,(CB_BITS-2)),PAGESIZE);}) ++#define cpage(m_) CEI(({ufixnum _m=(m_);ceil(sizeof(struct pageinfo)+_m+2*ceil(_m,(CB_BITS-2)),PAGESIZE);}),256) + #define mbytes(p_) ceil((p_)*PAGESIZE-sizeof(struct pageinfo),CB_BITS) + #define tpage(tm_,m_) (tm_->tm_type==t_relocatable ? npage(m_-(rb_limit-rb_pointer)+1) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_))) + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1941,3 +1941,12 @@ mbrk(void *); + + void + maybe_set_hole_from_maxpages(void); ++ ++void * ++alloc_code_space(size_t); ++ ++object ++fSmake_vector1_2(fixnum,fixnum,object,object); ++ ++inline struct pageinfo * ++get_pageinfo(void *); +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -78,6 +78,72 @@ struct rlimit data_rlimit; + #endif + #endif + ++static inline void * ++bsearchleq(void *i,void *v1,size_t n,size_t s,int (*c)(const void *,const void *)) { ++ ++ ufixnum nn=n>>1; ++ void *v=v1+nn*s; ++ int j=c(i,v); ++ ++ if (nn) ++ return !j ? v : (j>0 ? bsearchleq(i,v,n-nn,s,c) : bsearchleq(i,v1,nn,s,c)); ++ else ++ return j<=0 ? v : v+s; ++ ++} ++ ++ ++object contblock_array=Cnil; ++ ++static inline void ++expand_contblock_array(void) { ++ ++ if (contblock_array==Cnil) { ++ contblock_array=fSmake_vector1_2(16,aet_fix,Cnil,make_fixnum(0)); ++ contblock_array->v.v_self[0]=(object)&cb_pointer; ++ enter_mark_origin(&contblock_array); ++ } ++ ++ if (contblock_array->v.v_fillp==contblock_array->v.v_dim) { ++ ++ void *v=alloc_relblock(2*contblock_array->v.v_dim*sizeof(fixnum)); ++ ++ memcpy(v,contblock_array->v.v_self,contblock_array->v.v_dim*sizeof(fixnum)); ++ contblock_array->v.v_self=v; ++ contblock_array->v.v_dim*=2; ++ ++ } ++ ++} ++ ++static void ++contblock_array_push(void *p) { ++ ++ expand_contblock_array(); ++ contblock_array->v.v_self[contblock_array->v.v_fillp]=p; ++ contblock_array->v.v_fillp++; ++ ++} ++ ++static inline int ++acomp(const void *v1,const void *v2) { ++ ++ void *p1=*(void * const *)v1,*p2=*(void * const *)v2; ++ ++ return p1v.v_self,contblock_array->v.v_fillp,sizeof(*contblock_array->v.v_self),acomp); ++ struct pageinfo *p=(void *)pp>(void *)contblock_array->v.v_self ? pp[-1] : NULL; ++ ++ return p && (void *)p+p->in_use*PAGESIZE>x ? p : NULL; ++ ++} ++ + inline void + add_page_to_contblock_list(void *p,fixnum m) { + +@@ -89,13 +155,8 @@ add_page_to_contblock_list(void *p,fixnu + massert(pp->in_use==m); + pp->magic=PAGE_MAGIC; + +- if (contblock_list_head==NULL) +- contblock_list_tail=contblock_list_head=p; +- else if (pp > contblock_list_tail) { +- contblock_list_tail->next=p; +- contblock_list_tail=p; +- } +- ++ contblock_array_push(p); ++ + bzero(pagetochar(page(pp)),CB_DATA_START(pp)-(void *)pagetochar(page(pp))); + #ifdef SGC + if (sgc_enabled && tm_table[t_contiguous].tm_sgc) { +@@ -458,7 +519,7 @@ rebalance_maxpages(struct typemanager *m + for (i=t_start;iv.v_self[0]=(object)&cb_pointer; + enter_mark_origin(&cbv); + } +@@ -612,21 +673,6 @@ cbcomp(const void *v1,const void *v2) { + + } + +-static inline void * +-bsearchleq(void *i,void *v1,size_t n,size_t s,int (*c)(const void *,const void *)) { +- +- ufixnum nn=n>>1; +- void *v=v1+nn*s; +- int j=c(i,v); +- +- if (nn) +- return !j ? v : (j>0 ? bsearchleq(i,v,n-nn,s,c) : bsearchleq(i,v1,nn,s,c)); +- else +- return j<=0 ? v : v+s; +- +-} +- +- + static inline struct contblock *** + find_cbppp(struct contblock *cbp) { + +@@ -777,7 +823,7 @@ grow_linear1(struct typemanager *tm) { + static inline int + too_full_p(struct typemanager *tm) { + +- fixnum j,k,pf=tm->tm_percent_free ? tm->tm_percent_free : 30; ++ fixnum i,j,k,pf=tm->tm_percent_free ? tm->tm_percent_free : 30; + struct contblock *cbp; + struct pageinfo *pi; + +@@ -787,11 +833,13 @@ too_full_p(struct typemanager *tm) { + break; + case t_contiguous: + for (cbp=cb_pointer,k=0;cbp;cbp=cbp->cb_link) k+=cbp->cb_size; +- for (pi=contblock_list_head,j=0;pi;pi=pi->next) ++ for (i=j=0;iv.v_fillp;i++) { ++ pi=(void *)contblock_array->v.v_self[i]; + #ifdef SGC + if (!sgc_enabled || pi->sgc_flags&SGC_PAGE_FLAG) + #endif + j+=pi->in_use; ++ } + return 100*ktm_maxpage-tm->tm_npage; */ + add_pages(tm,m); + + return alloc_from_freelist(tm,n); +@@ -997,6 +1042,34 @@ alloc_contblock_no_gc(size_t n) { + + } + ++#ifndef MAX_CODE_ADDRESS ++#define MAX_CODE_ADDRESS -1UL ++#endif ++ ++void * ++alloc_code_space(size_t sz) { ++ ++ void *v; ++ ++ sz=CEI(sz,CPTR_SIZE); ++ ++ if (sSAcode_block_reserveA && ++ sSAcode_block_reserveA->s.s_dbind!=Cnil && sSAcode_block_reserveA->s.s_dbind->st.st_dim>=sz) { ++ ++ v=sSAcode_block_reserveA->s.s_dbind->st.st_self; ++ sSAcode_block_reserveA->s.s_dbind->st.st_self+=sz; ++ sSAcode_block_reserveA->s.s_dbind->st.st_dim-=sz; ++ sSAcode_block_reserveA->s.s_dbind->st.st_fillp=sSAcode_block_reserveA->s.s_dbind->st.st_dim; ++ ++ } else ++ v=alloc_contblock(sz); ++ ++ massert(v && (unsigned long)(v+sz)type==t_contiguous && p+v->in_use*PAGESIZE>x); +- +- return p; +- +-} +- +-/* inline struct pageinfo * */ +-/* get_pageinfo(void *x) { */ +-/* struct pageinfo *v=contblock_list_head;void *vv; */ +-/* for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next); */ +-/* return v; */ +-/* } */ +- + inline char + get_bit(char *v,struct pageinfo *pi,void *x) { + void *ve=CB_DATA_START(pi); +@@ -811,7 +784,7 @@ mark_stack_carefully(void *topv, void *b + + for (j=top ; j >= bottom ; j--) { + +- void *v=(void *)(*j),**a; ++ void *v=(void *)(*j); + struct pageinfo *pi; + + if (!VALID_DATA_ADDRESS_P(v)) continue; +@@ -822,7 +795,7 @@ mark_stack_carefully(void *topv, void *b + pi=pagetoinfo(p); + if (!pageinfo_p(pi)) continue; + +- if ((a=contblock_stack_list) && in_contblock_stack_list(pi,&a)) continue; ++ if (get_pageinfo(pi)) continue; + + tm=tm_of(pi->type); + if (tm->tm_type>=t_end) continue; +@@ -1067,14 +1040,24 @@ sweep_phase(void) { + static void + contblock_sweep_phase(void) { + ++ struct pageinfo *v; + STATIC char *s, *e, *p, *q; +- STATIC struct pageinfo *v; ++ object o; ++ ufixnum i; + + reset_contblock_freelist(); +- +- for (v=contblock_list_head;v;v=v->next) { ++ ++ o=sSAleaf_collection_thresholdA->s.s_dbind; ++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(-1); ++ ++ for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) { ++ + bool z; + ++#ifdef SGC ++ if (sgc_enabled && !(v->sgc_flags&SGC_PAGE_FLAG)) continue; ++#endif ++ + s=CB_DATA_START(v); + e=(void *)v+v->in_use*PAGESIZE; + +@@ -1090,14 +1073,9 @@ contblock_sweep_phase(void) { + bzero(CB_MARK_START(v),CB_SGCF_START(v)-CB_MARK_START(v)); + + } +-#ifdef DEBUG +- if (debug) { +- for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link) +- printf("%lud-byte contblock\n", cbp->cb_size); +- fflush(stdout); +- } +-#endif +- ++ ++ sSAleaf_collection_thresholdA->s.s_dbind=o; ++ + sweep_link_array(); + + } +@@ -1143,24 +1121,6 @@ GBC(enum type t) { + + ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); + +- { /*FIXME try to get this below the setjmp in mark_c_stack*/ +- struct pageinfo *v,*tv; +- ufixnum i; +- void *a; +- +- for (v=contblock_list_head,contblock_stack_list=NULL;v;v=v->next) +- for (i=1;iin_use;i++) { +- tv=pagetoinfo(page(v)+i); +- if (pageinfo_p(tv)) { +- a=contblock_stack_list; +- /* fprintf(stderr,"pushing %p\n",tv); */ +- contblock_stack_list=alloca(2*sizeof(a)); +- contblock_stack_list[0]=tv; +- contblock_stack_list[1]=a; +- } +- } +- } +- + if (in_signal_handler && t == t_relocatable) + error("cant gc relocatable in signal handler"); + +@@ -1312,12 +1272,7 @@ GBC(enum type t) { + } + #endif + +-#ifdef SGC +- if (sgc_enabled) +- sgc_contblock_sweep_phase(); +- else +-#endif +- contblock_sweep_phase(); ++ contblock_sweep_phase(); + #ifdef DEBUG + if (debug) + printf("contblock sweep ended (%d)\n", +@@ -1574,7 +1529,7 @@ mark_contblock(void *p, int s) { + sizeof(struct contblock). CM 20030827 */ + x = (char *)PFLR(p,CPTR_SIZE); + y = (char *)PCEI(q,CPTR_SIZE); +- v=get_pageinfo(x); ++ massert(v=get_pageinfo(x)); + #ifdef SGC + if (!sgc_enabled || (v->sgc_flags&SGC_PAGE_FLAG)) + #endif +@@ -1595,7 +1550,7 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + } + fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j); + +- for (i=j=0,v=contblock_list_head;v;i+=v->in_use,j++,v=v->next) ++ for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) + fprintf(stderr,"%lu pages at %p\n",(unsigned long)v->in_use,v); + fprintf(stderr,"\nTotal pages %lu in %lu pieces\n\n",i,j); + +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -242,32 +242,6 @@ relocate_symbols(Sym *sym,Sym *syme,Shdr + + } + +-#ifndef MAX_CODE_ADDRESS +-#define MAX_CODE_ADDRESS -1UL +-#endif +- +-static void * +-alloc_memory(ul sz) { +- +- void *v; +- +- if (sSAcode_block_reserveA && +- sSAcode_block_reserveA->s.s_dbind!=Cnil && sSAcode_block_reserveA->s.s_dbind->st.st_dim>=sz) { +- +- v=sSAcode_block_reserveA->s.s_dbind->st.st_self; +- sSAcode_block_reserveA->s.s_dbind->st.st_self+=sz; +- sSAcode_block_reserveA->s.s_dbind->st.st_dim-=sz; +- sSAcode_block_reserveA->s.s_dbind->st.st_fillp=sSAcode_block_reserveA->s.s_dbind->st.st_dim; +- +- } else +- v=alloc_contblock(sz); +- +- massert(v && (ul)(v+sz)cfd.cfd_size=sz; + memory->cfd.cfd_self=0; + memory->cfd.cfd_start=0; +- memory->cfd.cfd_start=alloc_memory(sz); ++ memory->cfd.cfd_start=alloc_code_space(sz); + + a=(ul)memory->cfd.cfd_start; + a=(a+ma)&~ma; +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -99,7 +99,7 @@ sgc_mark_phase(void) { + + /* mark all non recent data on writable contiguous pages */ + if (what_to_collect == t_contiguous) +- for (v=contblock_list_head;v;v=v->next) ++ for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) + if (v->sgc_flags&SGC_PAGE_FLAG) { + void *s=CB_DATA_START(v),*e=CB_DATA_END(v),*p,*q; + bool z=get_sgc_bit(v,s); +@@ -213,40 +213,6 @@ sgc_sweep_phase(void) { + } + } + +- +-static void +-sgc_contblock_sweep_phase(void) { +- +- STATIC char *s, *e, *p, *q; +- STATIC struct pageinfo *v; +- +- reset_contblock_freelist(); +- +- for (v=contblock_list_head;v;v=v->next) { +- bool z; +- +- if (!(v->sgc_flags&SGC_PAGE_FLAG)) continue; +- +- s=CB_DATA_START(v); +- e=CB_DATA_END(v); +- +- z=get_mark_bit(v,s); +- for (p=s;pnext) { ++ for (i=0;iv.v_fillp && (pi=(void *)contblock_array->v.v_self[i]) && countv.v_fillp; + + if (maxcbpagev.v_fillp); + +- contblock_list_tail->sgc_flags=SGC_PAGE_FLAG; ++ ((struct pageinfo *)contblock_array->v.v_self[fp])->sgc_flags=SGC_PAGE_FLAG; + + } + +@@ -743,17 +709,19 @@ sgc_start(void) { + { + + struct pageinfo *pi; +- ++ ufixnum j; ++ + { + + struct contblock **cbpp; + void *p=NULL,*pe; + struct pageinfo *pi; ++ ufixnum i; + + old_cb_pointer=cb_pointer; + reset_contblock_freelist(); + +- for (pi=contblock_list_head;pi;pi=pi->next) { ++ for (i=0;iv.v_fillp && (pi=(void *)contblock_array->v.v_self[i]);i++) { + + if (pi->sgc_flags!=SGC_PAGE_FLAG) continue; + +@@ -786,7 +754,7 @@ sgc_start(void) { + else + tm_of(pi->type)->tm_alt_npage++; + } +- for (pi=contblock_list_head;pi;pi=pi->next)/*FIXME*/ ++ for (j=0;jv.v_fillp && (pi=(void *)contblock_array->v.v_self[j]);j++) + if (pi->sgc_flags&SGC_WRITABLE) + for (i=0;iin_use;i++) + SET_WRITABLE(page(pi)+i); +@@ -932,7 +900,7 @@ sgc_quit(void) { + ((object) p)->d.s=SGC_NORMAL; + #endif + +- for (v=contblock_list_head;v;v=v->next) ++ for (i=0;iv.v_fillp &&(v=(void *)contblock_array->v.v_self[i]);i++) + if (v->sgc_flags&SGC_PAGE_FLAG) + bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v)); + +@@ -940,7 +908,7 @@ sgc_quit(void) { + struct pageinfo *pi; + for (pi=cell_list_head;pi;pi=pi->next) + pi->sgc_flags&=SGC_PERM_WRITABLE; +- for (pi=contblock_list_head;pi;pi=pi->next) ++ for (i=0;iv.v_fillp &&(pi=(void *)contblock_array->v.v_self[i]);i++) + pi->sgc_flags&=SGC_PERM_WRITABLE; + } + diff --git a/patches/Version_2_6_13pre41 b/patches/Version_2_6_13pre41 new file mode 100644 index 00000000..67e553ec --- /dev/null +++ b/patches/Version_2_6_13pre41 @@ -0,0 +1,185 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-32) unstable; urgency=medium + . + * Version_2_6_13pre40 + * Bug fix: "[INTL:pt_BR] Brazilian Portuguese debconf templates + translation", thanks to Adriano Rafael Gomes (Closes: #811523). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/811523 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -300,7 +300,8 @@ gcl_init_cmp_anon(void); + + #include "gmp_wrappers.h" + +-#define massert(a_) if (!(a_)) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__) ++#include ++#define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);}) + + extern bool writable_malloc; + #define writable_malloc_wrap(f_,rt_,a_...) ({rt_ v;bool w=writable_malloc;writable_malloc=1;v=f_(a_);writable_malloc=w;v;}) +--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp ++++ gcl-2.6.12/lsp/gcl_mislib.lsp +@@ -131,7 +131,7 @@ x)) + *gcl-major-version* *gcl-minor-version* *gcl-extra-version* + (if (member :ansi-cl *features*) "ANSI" "CLtL1") + (if (member :gprof *features*) "profiling" "") +- (gcl-compile-time) ++ *gcl-release-date* + "Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)" + "Binary License: " + (if gpled-modules (format nil "GPL due to GPL'ed components: ~a" gpled-modules) +--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.12/lsp/gcl_predlib.lsp +@@ -777,6 +777,7 @@ + (defvar *gcl-extra-version* nil) + (defvar *gcl-minor-version* nil) + (defvar *gcl-major-version* nil) ++(defvar *gcl-release-date* nil) + + (defun warn-version (majvers minvers extvers) + (and *gcl-major-version* *gcl-minor-version* *gcl-extra-version* +--- gcl-2.6.12.orig/makefile ++++ gcl-2.6.12/makefile +@@ -34,9 +34,9 @@ TESTDIR = ansi-tests + + VERSION=`cat majvers`.`cat minvers` + +-all: $(BUILD_BFD) system command cmpnew/gcl_collectfn.o lsp/gcl_info.o do-gcl-tk # do-info ++all: $(BUILD_BFD) system command cmpnew/gcl_collectfn.o lsp/gcl_info.o do-gcl-tk release # do-info + +-ASRC:=$(shell ls -1 o/*.c lsp/*.lsp cmpnew/*.lsp mod/*.lsp pcl/*sp clcs/*sp xgcl-2/*p) #o/*.d o/*.h h/*.h ++ASRC:=$(shell ls -1 o/*.c lsp/*.lsp cmpnew/*.lsp pcl/*sp clcs/*sp xgcl-2/*p) #o/*.d o/*.h h/*.h + TAGS: $(ASRC) + etags --regex='/\#.`(defun[ \n\t]+\([^ \n\t]+\)/' $^ + +@@ -44,6 +44,9 @@ system: $(PORTDIR)/$(FLISP) + # [ "$(X_LIBS)" == "" ] || (cd xgcl-2 && make saved_xgcl LISP=../$< && mv saved_xgcl ../$(PORTDIR)/$(FLISP)) + touch $@ + ++release: majvers minvers ++ date >$@ ++ + xgcl: $(PORTDIR)/saved_xgcl + + $(PORTDIR)/saved_xgcl: $(PORTDIR)/saved_gcl +--- gcl-2.6.12.orig/o/error.c ++++ gcl-2.6.12/o/error.c +@@ -27,6 +27,7 @@ Foundation, 675 Mass Ave, Cambridge, MA + */ + + #include ++#include + #include "include.h" + object siSuniversal_error_handler; + +@@ -36,11 +37,11 @@ void + assert_error(const char *a,unsigned l,const char *f,const char *n) { + + if (!raw_image && core_end && core_end==sbrk(0)) +- FEerror("The assertion ~a on line ~a of ~a in function ~a failed",4, ++ FEerror("The assertion ~a on line ~a of ~a in function ~a failed: ~a",5, + make_simple_string(a),make_fixnum(l), +- make_simple_string(f),make_simple_string(n)); ++ make_simple_string(f),make_simple_string(n),make_simple_string(strerror(errno))); + else { +- emsg("The assertion %s on line %d of %s in function %s failed",a,l,f,n); ++ emsg("The assertion %s on line %d of %s in function %s failed: %s",a,l,f,n,strerror(errno)); + do_gcl_abort(); + } + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -242,7 +242,7 @@ get_gc_environ(void) { + } + + gc_page_min=0.5; +- if ((e=getenv("GCL_GC_PAGE_THRESH"))) { ++ if ((e=getenv("GCL_GC_PAGE_MIN"))) { + massert(sscanf(e,"%lf",&gc_page_min)==1); + massert(gc_page_min>=0.0); + } +@@ -1028,12 +1028,6 @@ DEFUNO_NEW("IDENTITY",object,fLidentity, + RETURN1 (x0); + } + +-DEFUNO_NEW("GCL-COMPILE-TIME",object,fSgcl_compile_time,SI +- ,0,0,NONE,OO,OO,OO,OO,void,Lgcl_compile_time,(void),"") +-{ +- RETURN1 (make_simple_string(__DATE__ " " __TIME__)); +-} +- + DEFUNO_NEW("LDB1",object,fSldb1,SI + ,3,3,NONE,OI,II,OO,OO,void,Lldb1,(fixnum a,fixnum b, fixnum c),"") + { +--- gcl-2.6.12.orig/o/sfasli.c ++++ gcl-2.6.12/o/sfasli.c +@@ -115,10 +115,9 @@ LFD(build_symbol_table)(void) { + int + use_symbols(double d,...) { + ++ double d2; + #ifndef DARWIN +- + extern void sincos(double,double *,double *); +- double d2; + + sincos(d,&d,&d2); + +--- /dev/null ++++ gcl-2.6.12/release +@@ -0,0 +1 @@ ++Fri Apr 22 15:51:11 UTC 2016 +--- gcl-2.6.12.orig/unixport/makefile ++++ gcl-2.6.12/unixport/makefile +@@ -72,10 +72,11 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l + sys_init.lsp: sys_init.lsp.in + + cat $< | sed \ +- -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `date`#1" \ ++ -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `cat ../release`#1" \ + -e "s#@LI-EXTVERS@#`cat ../minvers | cut -f2 -d.`#1" \ + -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ + -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ ++ -e "s#@LI-RELEASE@#`cat ../release`#1" \ + -e "s#@LI-CC@#\"$(CC) -c $(FINAL_CFLAGS)\"#1" \ + -e "s#@LI-LD@#\"$(CC) $(LD_FLAGS) -o \"#1" \ + -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -51,7 +51,8 @@ + + (setq *gcl-extra-version* @LI-EXTVERS@ + *gcl-minor-version* @LI-MINVERS@ +- *gcl-major-version* @LI-MAJVERS@) ++ *gcl-major-version* @LI-MAJVERS@ ++ *gcl-release-date* "@LI-RELEASE@") + + (defvar *system-banner* (default-system-banner)) + (setq *optimize-maximum-pages* t) +@@ -83,3 +84,5 @@ + (let* ((i 4096)(j (si::equal-tail-recursion-check i))) + (unless (<= (ash i -1) j) + (warn "equal is not tail recursive ~s ~s" i j))) ++ ++(format t "~s heap words available~%" (multiple-value-bind (a b c d) (si::heap-report) (/ (- d c) (/ a 8)))) diff --git a/patches/Version_2_6_13pre45 b/patches/Version_2_6_13pre45 new file mode 100644 index 00000000..4adb1a28 --- /dev/null +++ b/patches/Version_2_6_13pre45 @@ -0,0 +1,253 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-34) unstable; urgency=medium + . + * Version_2_6_13pre45 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-09-23 + +--- gcl-2.6.12.orig/h/unrandomize.h ++++ gcl-2.6.12/h/unrandomize.h +@@ -23,7 +23,6 @@ + int i,j,k; + char **n,**a; + void *v; +- argv[0]="/proc/self/exe"; + for (i=j=0;argv[i];i++) + j+=strlen(argv[i])+1; + for (k=0;envp[k];k++) +--- gcl-2.6.12.orig/lsp/gcl_serror.lsp ++++ gcl-2.6.12/lsp/gcl_serror.lsp +@@ -174,7 +174,7 @@ + (format *error-output* "~&If continued: ") + (funcall (restart-report-function correctable) *error-output*)) + (force-output *error-output*) +- (break-level condition))) ++ (when *break-enable* (break-level condition)))) + + + (defun dbl-eval (- &aux (break-command t)) +@@ -186,54 +186,51 @@ + (t (setq break-command nil) (evalhook - nil nil *break-env*)))))) + (cons break-command val-list))) + +-(defun do-break-level (at env p-e-p debug-level break-level &aux (first t)) ++(defun dbl-rpl-loop (p-e-p) + +- (do nil (nil) +- +- (unless +- (with-simple-restart +- (abort "Return to debug level ~D." debug-level) +- (not +- (catch 'step-continue +- (let* ((*break-level* break-level) +- (*break-enable* (unless p-e-p *break-enable*)) +- (*readtable* (or *break-readtable* *readtable*)) +- *break-env* *read-suppress*); *error-stack*) +- +- (setq +++ ++ ++ + + -) +- +- (when first +- (catch-fatal 1) +- (setq *interrupt-enable* t first nil) +- (cond (p-e-p +- (format *debug-io* "~&~A~2%" at) +- (set-current) +- (setq *no-prompt* nil) +- (show-restarts)) +- ((set-back at env)))) +- +- (if *no-prompt* +- (setq *no-prompt* nil) +- (format *debug-io* "~&~a~a>~{~*>~}" +- (if p-e-p "" "dbl:") +- (if (eq *package* (find-package 'user)) "" (package-name *package*)) +- break-level)) +- (force-output *error-output*) +- +- (setq - (dbl-read *debug-io* nil *top-eof*)) +- (when (eq - *top-eof*) (bye -1)) +- (let* ((ev (dbl-eval -)) +- (break-command (car ev)) +- (values (cdr ev))) +- (and break-command (eq (car values) :resume)(return)) +- (setq /// // // / / values *** ** ** * * (car /)) +- (fresh-line *debug-io*) +- (dolist (val /) +- (prin1 val *debug-io*) +- (terpri *debug-io*))) +- nil)))) +- (terpri *debug-io*) +- (break-current)))) ++ (setq +++ ++ ++ + + -) ++ ++ (if *no-prompt* ++ (setq *no-prompt* nil) ++ (format *debug-io* "~&~a~a>~{~*>~}" ++ (if p-e-p "" "dbl:") ++ (if (eq *package* (find-package 'user)) "" (package-name *package*)) ++ *break-level*)) ++ (force-output *error-output*) ++ ++ (setq - (dbl-read *debug-io* nil *top-eof*)) ++ (when (eq - *top-eof*) (bye -1)) ++ (let* ((ev (dbl-eval -)) ++ (break-command (car ev)) ++ (values (cdr ev))) ++ (unless (and break-command (eq (car values) :resume)) ++ (setq /// // // / / values *** ** ** * * (car /)) ++ (fresh-line *debug-io*) ++ (dolist (val /) ++ (prin1 val *debug-io*) ++ (terpri *debug-io*)) ++ (dbl-rpl-loop p-e-p)))) ++ ++(defun do-break-level (at env p-e-p debug-level); break-level ++ ++ (unless ++ (with-simple-restart ++ (abort "Return to debug level ~D." debug-level) ++ ++ (catch-fatal 1) ++ (setq *interrupt-enable* t) ++ (cond (p-e-p ++ (format *debug-io* "~&~A~2%" at) ++ (set-current) ++ (setq *no-prompt* nil) ++ (show-restarts)) ++ ((set-back at env))) ++ ++ (not (catch 'step-continue (dbl-rpl-loop p-e-p)))) ++ ++ (terpri *debug-io*) ++ (break-current) ++ (do-break-level at env p-e-p debug-level))) + + + (defun break-level (at &optional env) +@@ -242,10 +239,10 @@ + (- -) + (* *) (** **) (*** ***) + (/ /) (// //) (/// ///) +- (break-level (if p-e-p (cons t *break-level*) *break-level*)) + (debug-level *debug-level*) + (*quit-tags* (cons (cons *break-level* *quit-tag*) *quit-tags*)) + *quit-tag* ++ (*break-level* (if p-e-p (cons t *break-level*) *break-level*)) + (*ihs-base* (1+ *ihs-top*)) + (*ihs-top* (ihs-top)) + (*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top)))) +@@ -255,9 +252,11 @@ + (*debug-restarts* (compute-restarts)) + (*debug-abort* (find-restart 'abort)) + (*debug-continue* (find-restart 'continue)) +- (*abort-restarts* (remove-if-not (lambda (x) (eq 'abort (restart-name x))) *debug-restarts*))) ++ (*abort-restarts* (remove-if-not (lambda (x) (eq 'abort (restart-name x))) *debug-restarts*)) ++ (*readtable* (or *break-readtable* *readtable*)) ++ *break-env* *read-suppress*) + +- (do-break-level at env p-e-p debug-level break-level))) ++ (do-break-level at env p-e-p debug-level))) + + (putprop 'break-level t 'compiler::cmp-notinline) + +@@ -278,6 +277,6 @@ + (setq message "")))) + (with-simple-restart + (continue "Return from break.") +- (let ((*break-enable* t)) (break-level message))) ++ (break-level message)) + nil) + (putprop 'break t 'compiler::cmp-notinline) +--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp ++++ gcl-2.6.12/lsp/sys-proclaim.lisp +@@ -4,7 +4,7 @@ + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) + ANSI-LOOP::LOOP-EMIT-FINAL-VALUE SYSTEM::INSPECT-CHARACTER +- SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS ++ SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS SYSTEM::DBL-RPL-LOOP + SYSTEM::RESTART-FUNCTION COMMON-LISP::TANH COMMON-LISP::FIFTH + SLOOP::PARSE-LOOP-INITIALLY SYSTEM::NEXT-STACK-FRAME + SYSTEM::IDESCRIBE SYSTEM::PROCESS-ARGS SYSTEM::LEAP-YEAR-P +@@ -268,7 +268,7 @@ + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::T) +- SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION ++ SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION SYSTEM::DO-BREAK-LEVEL + SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC + SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS + SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN)) +@@ -334,7 +334,7 @@ + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::MAKE-PREDICATE SYSTEM::DO-BREAK-LEVEL ++ SYSTEM::MAKE-PREDICATE + SYSTEM::MAKE-CONSTRUCTOR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +@@ -519,4 +519,4 @@ + (COMMON-LISP::FUNCTION + (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) + COMMON-LISP::FIXNUM) +- SYSTEM::ROUND-UP)) +\ No newline at end of file ++ SYSTEM::ROUND-UP)) +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -464,19 +464,12 @@ DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",o + int + main(int argc, char **argv, char **envp) { + +-#ifdef CAN_UNRANDOMIZE_SBRK +-#include +-#include +-#include "unrandomize.h" +-#endif +- +- gcl_init_alloc(&argv); +- + #ifdef GET_FULL_PATH_SELF + GET_FULL_PATH_SELF(kcl_self); + #else + kcl_self = argv[0]; + #endif ++ + #ifdef __MINGW32__ + { + char *s=kcl_self; +@@ -485,6 +478,14 @@ main(int argc, char **argv, char **envp) + #endif + *argv=kcl_self; + ++#ifdef CAN_UNRANDOMIZE_SBRK ++#include ++#include ++#include "unrandomize.h" ++#endif ++ ++ gcl_init_alloc(&argv); ++ + setbuf(stdin, stdin_buf); + setbuf(stdout, stdout_buf); + #ifdef _WIN32 diff --git a/patches/Version_2_6_13pre46 b/patches/Version_2_6_13pre46 new file mode 100644 index 00000000..9551eed6 --- /dev/null +++ b/patches/Version_2_6_13pre46 @@ -0,0 +1,237 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-34) unstable; urgency=medium + . + * Version_2_6_13pre45 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-09-30 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -28,7 +28,7 @@ + + + (export '(*compile-print* *compile-verbose*)) +-(import 'si::*tmp-dir* 'compiler) ++(import 'si::(*tmp-dir* *cc* *ld* *objdump*)) + (import 'si::*error-p* 'compiler) + + ;;; This had been true with Linux 1.2.13 a.out or even older +@@ -85,9 +85,8 @@ + (code result) (system (mysub (ts string) "$" "\\$")) + (unless (and (zerop code) (zerop result)) + (cerror "Continues anyway." +- "(SYSTEM ~S) returned a non-zero value ~D." +- string +- result) ++ "(SYSTEM ~S) returned a non-zero value ~D ~D." ++ string code result) + (setq *error-p* t)) + (values result))) + +@@ -428,8 +427,8 @@ Cannot compile ~a.~%" + (si::copy-stream st *standard-output*)) + (with-open-file (st hn) + (si::copy-stream st *standard-output*)) +- (when (zerop (system "which objdump >/dev/null")) +- (safe-system (si::string-concatenate "objdump --source " (namestring on)))) ++ (when (eql (aref *objdump* 0) #\/);program found at startup in path ++ (safe-system (si::string-concatenate *objdump* (namestring on)))) + (mdelete-file cn) + (mdelete-file dn) + (mdelete-file hn) +@@ -470,8 +469,6 @@ Cannot compile ~a.~%" + (terpri *compiler-output2*))))) + + +-(defvar *cc* "cc") +-(defvar *ld* "ld") + (defvar *ld-libs* "ld-libs") + (defvar *opt-three* "") + (defvar *opt-two* "") +@@ -489,7 +486,7 @@ Cannot compile ~a.~%" + (setq na (namestring + (make-pathname :name name :type (pathname-type(first args))))) + #+(or dos winnt) +- (format nil "~a -I~a ~a ~a -c -w ~s -o ~s" ++ (format nil "~a -I~a ~a ~a -c -w ~a -o ~a" + *cc* + (concatenate 'string si::*system-directory* "../h") + (if (and (boundp '*c-debug*) *c-debug*) " -g " "") +@@ -502,7 +499,7 @@ Cannot compile ~a.~%" + ) + + #-(or dos winnt) +- (format nil "~a -I~a ~a ~a -c ~s -o ~s ~a" ++ (format nil "~a -I~a ~a ~a -c ~a -o ~a ~a" + *cc* + (concatenate 'string si::*system-directory* "../h") + (if (and (boundp '*c-debug*) *c-debug*) " -g " "") +--- gcl-2.6.12.orig/h/elf32_mips_reloc_special.h ++++ gcl-2.6.12/h/elf32_mips_reloc_special.h +@@ -147,3 +147,6 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + (*(a_))->address=p->st_value; \ + break; \ + }}}) ++ ++#undef LOAD_SYM_BY_NAME ++#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"__moddi3",8)) +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -361,7 +361,7 @@ extern bool writable_malloc; + #define prof_block(x) x + #endif + +-#define psystem(x) prof_block(system(x)) ++#define psystem(x) prof_block(vsystem(x)) + #define pfork() prof_block(fork()) + + #include "error.h" +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -601,9 +601,21 @@ First directory is checked for first nam + :device (pathname-device x) + :directory (append (pathname-directory x) y))))))))) + ++(defun get-path (s &aux (m (string-match "([^/ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1)) ++ (r (with-open-file (s (concatenate 'string "|which " (subseq s b e))) (read s nil 'eof)))) ++ (if (eq r 'eof) s (concatenate 'string (string-downcase r) (subseq s e)))) ++ ++ ++(defvar *cc* "cc") ++(defvar *ld* "ld") ++(defvar *objdump* "objdump --source ") ++ + (defun set-up-top-level (&aux (i (argc)) tem) + (declare (fixnum i)) +- (setq *tmp-dir* (get-temp-dir)) ++ (setq *tmp-dir* (get-temp-dir) ++ *cc* (get-path *cc*) ++ *ld* (get-path *ld*) ++ *objdump* (get-path *objdump*)) + (dotimes (j i) (push (argv j) tem)) + (setq *command-args* (nreverse tem)) + (setq tem *lib-directory*) +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -613,7 +613,8 @@ BEGIN: + else + fclose(strm->sm.sm_fp); + strm->sm.sm_fp = NULL; +- if (type_of(strm->sm.sm_object0 ) == t_cons && ++ if (strm->sm.sm_object0 && ++ type_of(strm->sm.sm_object0 ) == t_cons && + Mcar(strm->sm.sm_object0 ) == sSAallow_gzipped_fileA) + fLdelete_file(Mcdr(strm->sm.sm_object0)); + break; +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -502,6 +502,7 @@ make_socket_pair() + stream_in->sm.sm_buffer = 0; + stream_in->sm.sm_int0 = sockets_in[1]; + stream_in->sm.sm_int1 = 0; ++ stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL; + stream_out = (object) alloc_object(t_stream); + stream_out->sm.sm_mode = smm_output; + stream_out->sm.sm_fp = fp2; +@@ -510,6 +511,7 @@ make_socket_pair() + setup_stream_buffer(stream_out); + stream_out->sm.sm_int0 = sockets_out[1]; + stream_out->sm.sm_int1 = 0; ++ stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL; + stream = make_two_way_stream(stream_in, stream_out); + return(stream); + } +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -54,9 +54,10 @@ License for more details. + + #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) + #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) +-#define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) +-#define LOAD_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info),_t=ELF_ST_TYPE(sym->st_info); \ +- sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK || (_t>=STT_LOPROC && _t<=STT_HIPROC));}) ++#define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) ++#define LOAD_SYM_BY_BIND(sym) ({ul _b=ELF_ST_BIND(sym->st_info); sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) ++#define LOAD_SYM_BY_NAME(sym,st1) 0 ++#define LOAD_SYM(sym,st1) (LOAD_SYM_BY_BIND(sym)||LOAD_SYM_BY_NAME(sym,st1)) + + #define MASK(n) (~(~0ULL << (n))) + +@@ -410,7 +411,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym * + + for (sym=sym1;sym + #include + #include +- ++#include + + #include "include.h" + ++int ++vsystem(const char *command) { ++ ++ unsigned j,n=strlen(command); ++ char *z=alloca(n+1),**p1,**pp,*c; ++ int s; ++ pid_t pid; ++ ++ memcpy(z,command,n+1); ++ for (j=0,c=z;strtok(c," \n\t");c=NULL,j++); ++ ++ memcpy(z,command,n+1); ++ p1=alloca((j+1)*sizeof(*p1)); ++ for (pp=p1,c=z;(*pp=strtok(c," \n\t"));c=NULL,pp++); ++ ++ if (!(pid=vfork())) { ++ execvp(*p1,p1); ++ _exit(2); ++ } ++ ++ massert(pid>0); ++ massert(pid==waitpid(pid,&s,0)); ++ ++ return s; ++ ++} ++ ++ + #ifdef ATT3B2 + #include + int diff --git a/patches/Version_2_6_13pre47 b/patches/Version_2_6_13pre47 new file mode 100644 index 00000000..ba92ac2b --- /dev/null +++ b/patches/Version_2_6_13pre47 @@ -0,0 +1,36 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-35) unstable; urgency=medium + . + * Version_2_6_13pre46 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-09-30 + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -229,7 +229,7 @@ get_gc_environ(void) { + + const char *e; + +- mem_multiple=0.85; ++ mem_multiple=1.0; + if ((e=getenv("GCL_MEM_MULTIPLE"))) { + massert(sscanf(e,"%lf",&mem_multiple)==1); + massert(mem_multiple>=0.0); diff --git a/patches/Version_2_6_13pre48 b/patches/Version_2_6_13pre48 new file mode 100644 index 00000000..e3a07616 --- /dev/null +++ b/patches/Version_2_6_13pre48 @@ -0,0 +1,59 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-35) unstable; urgency=medium + . + * Version_2_6_13pre47 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-01 + +--- gcl-2.6.12.orig/h/elf32_hppa_reloc_special.h ++++ gcl-2.6.12/h/elf32_hppa_reloc_special.h +@@ -39,3 +39,6 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + return 0; + + } ++ ++#undef LOAD_SYM_BY_NAME ++#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"$$dyncall",8)) +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -31,16 +31,16 @@ Foundation, 675 Mass Ave, Cambridge, MA + int + vsystem(const char *command) { + +- unsigned j,n=strlen(command); +- char *z=alloca(n+1),**p1,**pp,*c; ++ unsigned j,n=strlen(command)+1; ++ char *z=alloca(n),**p1,**pp,*c; + int s; + pid_t pid; + +- memcpy(z,command,n+1); +- for (j=0,c=z;strtok(c," \n\t");c=NULL,j++); ++ memcpy(z,command,n); ++ for (j=1,c=z;strtok(c," \n\t");c=NULL,j++); + +- memcpy(z,command,n+1); +- p1=alloca((j+1)*sizeof(*p1)); ++ memcpy(z,command,n); ++ p1=alloca(j*sizeof(*p1)); + for (pp=p1,c=z;(*pp=strtok(c," \n\t"));c=NULL,pp++); + + if (!(pid=vfork())) { diff --git a/patches/Version_2_6_13pre49 b/patches/Version_2_6_13pre49 new file mode 100644 index 00000000..74117076 --- /dev/null +++ b/patches/Version_2_6_13pre49 @@ -0,0 +1,33 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-36) unstable; urgency=medium + . + * Version_2_6_13pre48 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-03 + +--- gcl-2.6.12.orig/h/elf32_hppa_reloc_special.h ++++ gcl-2.6.12/h/elf32_hppa_reloc_special.h +@@ -41,4 +41,4 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + } + + #undef LOAD_SYM_BY_NAME +-#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"$$dyncall",8)) ++#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"$$",2)) diff --git a/patches/Version_2_6_13pre5 b/patches/Version_2_6_13pre5 new file mode 100644 index 00000000..b1643483 --- /dev/null +++ b/patches/Version_2_6_13pre5 @@ -0,0 +1,83 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-5) unstable; urgency=medium + . + * Version_2_6_13pre4 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/page.h ++++ gcl-2.6.12/h/page.h +@@ -85,10 +85,8 @@ extern int sgc_enabled; + + extern long resv_pages; + extern int reserve_pages_for_signal_handler; +-/* #define CONT_MARK_PAGE (((page(heap_end)-first_data_page)*(PAGESIZE/(CPTR_SIZE*CHAR_SIZE))+PAGESIZE-1)/PAGESIZE) */ +-/* #define available_pages ((fixnum)(real_maxpage-page(heap_end)-2*nrbpage-CONT_MARK_PAGE-resv_pages)) */ + +-extern struct pageinfo *cell_list_head,*cell_list_tail/* ,*contblock_list_head,*contblock_list_tail */; ++extern struct pageinfo *cell_list_head,*cell_list_tail; + extern object contblock_array; + + #define PAGE_MAGIC 0x2e +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -506,31 +506,25 @@ rebalance_maxpages(struct typemanager *m + + if (j+d>phys_pages) { + +- ufixnum k=0; ++ ufixnum k,e=j+d-phys_pages; ++ double f; + +- for (i=t_start;ik+phys_pages-j ? k+phys_pages-j : d; +- if (d<=0) ++ e=e>k ? k : e; ++ if (e+phys_pages-j<=0) + return 0; + ++ f=1.0-(double)e/k; ++ + for (i=t_start;i((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage)) */ +- /* return 0; */ +- /* for (i=t_start;itm_maxpage+(phys_pages-sum_maxpages()))/(my_tm->tm_type==t_relocatable ? 2 : 1))); + + return 1; + diff --git a/patches/Version_2_6_13pre50 b/patches/Version_2_6_13pre50 new file mode 100644 index 00000000..e17b6272 --- /dev/null +++ b/patches/Version_2_6_13pre50 @@ -0,0 +1,223 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-37) unstable; urgency=medium + . + * Version_2_6_13pre49 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-04 + +--- gcl-2.6.12.orig/o/array.c ++++ gcl-2.6.12/o/array.c +@@ -850,31 +850,33 @@ raw_aet_ptr(object x, short int typ) + */ + + void +-gset(void *p1, void *val, int n, int typ) +-{ if (val==0) ++gset(void *p1, void *val, int n, int typ) { ++ ++ if (val==0) + val = aet_types[typ].dflt; +- switch (typ){ ++ ++ switch (typ){ + + #define GSET(p,n,typ,val) {typ x = *((typ *) val); GSET1(p,n,typ,x)} +-#define GSET1(p,n,typ,val) while (n-- > 0) \ ++#define GSET1(p,n,typ,val) while (n-- > 0) \ + { *((typ *) p) = val; \ +- p = p + sizeof(typ); \ +- } break; ++ p = p + sizeof(typ); \ ++ } break; + +- case aet_object: GSET(p1,n,object,val); +- case aet_ch: GSET(p1,n,char,val); +- /* Note n is number of fixnum WORDS for bit */ +- case aet_bit: GSET(p1,n,fixnum,val); +- case aet_fix: GSET(p1,n,fixnum,val); +- case aet_sf: GSET(p1,n,shortfloat,val); +- case aet_lf: GSET(p1,n,longfloat,val); +- case aet_char: GSET(p1,n,char,val); +- case aet_uchar: GSET(p1,n,unsigned char,val); +- case aet_short: GSET(p1,n,short,val); +- case aet_ushort: GSET(p1,n,unsigned short,val); +- default: FEerror("bad elttype",0); +- } ++ case aet_object: GSET(p1,n,object,val); ++ case aet_ch: GSET(p1,n,char,val); ++ /* Note n is number of fixnum WORDS for bit */ ++ case aet_bit: GSET(p1,n,fixnum,val); ++ case aet_fix: GSET(p1,n,fixnum,val); ++ case aet_sf: GSET(p1,n,shortfloat,val); ++ case aet_lf: GSET(p1,n,longfloat,val); ++ case aet_char: GSET(p1,n,char,val); ++ case aet_uchar: GSET(p1,n,unsigned char,val); ++ case aet_short: GSET(p1,n,short,val); ++ case aet_ushort: GSET(p1,n,unsigned short,val); ++ default: FEerror("bad elttype",0); + } ++} + + + #define W_SIZE (BV_BITS*sizeof(fixnum)) +@@ -894,38 +896,43 @@ implementation dependent results.") + int n1=fix(n1o),nc; + if (VFUN_NARGS==4) + { n1 = x->v.v_dim - i1;} +- if (typ1==aet_bit) +- {if (i1 % CHAR_SIZE) +- badcopy: +- FEerror("Bit copies only if aligned",0); +- else +- {int rest=n1%CHAR_SIZE; +- if (rest!=0 ) +- {if (typ2!=aet_bit) +- goto badcopy; +- {while(rest> 0) +- { fSaset1(y,i2+n1-rest,(fLrow_major_aref(x,i1+n1-rest))); +- rest--;} +- }} +- i1=i1/CHAR_SIZE ; +- n1=n1/CHAR_SIZE; +- typ1=aet_char; +- }}; +- if (typ2==aet_bit) +- {if (i2 % CHAR_SIZE) +- goto badcopy; +- i2=i2/CHAR_SIZE ;} +- if ((typ1 ==aet_object || +- typ2 ==aet_object) && typ1 != typ2) ++ if (typ1==aet_bit) { ++ if (i1 % CHAR_SIZE) ++ badcopy: ++ FEerror("Bit copies only if aligned",0); ++ else { ++ int rest=n1%CHAR_SIZE; ++ if (rest!=0) { ++ if (typ2!=aet_bit) ++ goto badcopy; ++ while(rest> 0) { ++ fSaset1(y,i2+n1-rest,(fLrow_major_aref(x,i1+n1-rest))); ++ rest--; ++ } ++ } ++ i1=i1/CHAR_SIZE ; ++ n1=n1/CHAR_SIZE; ++ typ1=aet_char; ++ } ++ } ++ ++ if (typ2==aet_bit) { ++ if (i2 % CHAR_SIZE) ++ goto badcopy; ++ i2=i2/CHAR_SIZE ; ++ } ++ ++ if ((typ1 ==aet_object || typ2 ==aet_object) && typ1 != typ2) + FEerror("Can't copy between different array types",0); + nc=n1 * aet_sizes[(int)typ1]; +- if (i1+n1 > x->a.a_dim +- || ((y->a.a_dim - i2) *aet_sizes[(int)typ2]) < nc) ++ if (i1+n1 > x->a.a_dim || ((y->a.a_dim - i2) *aet_sizes[(int)typ2]) < nc) + FEerror("Copy out of bounds",0); + bcopy(x->ust.ust_self + (i1*aet_sizes[(int)typ1]), + y->ust.ust_self + (i2*aet_sizes[(int)typ2]), + nc); ++ + return x; ++ + } + + /* X is the header of an array. This supplies the body which +--- gcl-2.6.12.orig/o/predicate.c ++++ gcl-2.6.12/o/predicate.c +@@ -744,14 +744,13 @@ BEGIN: + if (tx == t_complex) + return(contains_sharp_comma(x->cmp.cmp_real) || + contains_sharp_comma(x->cmp.cmp_imag)); +- if (tx == t_vector) +- { +- int i; +- if (x->v.v_elttype == aet_object) +- for (i = 0; i < x->v.v_fillp; i++) +- if (contains_sharp_comma(x->v.v_self[i])) +- return(TRUE); +- return(FALSE); ++ if (tx == t_vector) { ++ int i; ++ if (x->v.v_elttype == aet_object) ++ for (i = 0; i < x->v.v_fillp; i++) ++ if (contains_sharp_comma(x->v.v_self[i])) ++ return(TRUE); ++ return(FALSE); + } + if (tx == t_cons) { + if (x->c.c_car == siSsharp_comma) +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -32,25 +32,39 @@ int + vsystem(const char *command) { + + unsigned j,n=strlen(command)+1; +- char *z=alloca(n),**p1,**pp,*c; ++ char *z,*c; ++ const char *x1[]={"/bin/sh","-c",NULL,NULL},*spc=" \n\t",**p1,**pp; + int s; + pid_t pid; + +- memcpy(z,command,n); +- for (j=1,c=z;strtok(c," \n\t");c=NULL,j++); ++ if (strpbrk(command,"\"'$<>")) + +- memcpy(z,command,n); +- p1=alloca(j*sizeof(*p1)); +- for (pp=p1,c=z;(*pp=strtok(c," \n\t"));c=NULL,pp++); ++ (p1=x1)[2]=command; ++ ++ else { ++ ++ z=alloca(n); ++ memcpy(z,command,n); ++ for (j=1,c=z;strtok(c,spc);c=NULL,j++); ++ ++ memcpy(z,command,n); ++ p1=alloca(j*sizeof(*p1)); ++ for (pp=p1,c=z;(*pp=strtok(c,spc));c=NULL,pp++); ++ ++ } + + if (!(pid=vfork())) { +- execvp(*p1,p1); +- _exit(2); ++ errno=0; ++ execvp(*p1,(void *)p1); ++ _exit(128|(errno&0x7f)); + } + + massert(pid>0); + massert(pid==waitpid(pid,&s,0)); + ++ if ((s>>8)&128) ++ emsg("execvp failure when executing '%s': %s\n",command,strerror((s>>8)&0x7f)); ++ + return s; + + } diff --git a/patches/Version_2_6_13pre52 b/patches/Version_2_6_13pre52 new file mode 100644 index 00000000..ea69e84b --- /dev/null +++ b/patches/Version_2_6_13pre52 @@ -0,0 +1,36 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-65) unstable; urgency=medium + . + * list_order.25 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-02-22 + +--- gcl-2.6.12.orig/makefile ++++ gcl-2.6.12/makefile +@@ -149,7 +149,7 @@ command: + merge: + $(CC) -o merge merge.c + +-LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/sys_init.lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) unixport/gcl.script ++LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/package.lisp pcl/package.lisp clcs/package.lisp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/sys_init.lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew xgcl-2 pcl clcs) unixport/gcl.script + + install-command: + rm -f $(DESTDIR)$(prefix)/bin/gcl diff --git a/patches/Version_2_6_13pre54 b/patches/Version_2_6_13pre54 new file mode 100644 index 00000000..d5d69f71 --- /dev/null +++ b/patches/Version_2_6_13pre54 @@ -0,0 +1,2878 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-65) unstable; urgency=medium + . + * Version_2_6_13pre52 + * Bug fix: "FTBFS on hurd-i386", thanks to svante.signell@gmail.com; + (Closes: #802593). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/802593 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-02 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp +@@ -49,7 +49,6 @@ + (setq *reservations* nil) + (setq *closures* nil) + (setq *top-level-forms* nil) +- (setq *non-package-operation* nil) + (setq *function-declarations* nil) + (setq *inline-functions* nil) + (setq *inline-blocks* 0) +@@ -71,12 +70,10 @@ + (defun add-symbol (symbol) (add-object symbol)) + + (defun add-object2 (object) +- (let* ((init (when (si::contains-sharp-comma object) +- (if (when (consp object) (eq (car object) 'si::|#,|)) +- (cdr object) (si::string-to-object (wt-to-string object))))) ++ (let* ((init (if (when (consp object) (eq (car object) '|#,|)) (cdr object) `',object)) + (object (if (when (consp init) (eq (car init) 'si::nani)) (si::nani (cadr init)) object))) + (cond ((gethash object *objects*)) +- ((push-data-incf (unless init object)) ++ ((push-data-incf nil) + (when init (add-init `(si::setvv ,*next-vv* ,init))) + (setf (gethash object *objects*) *next-vv*))))) + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -180,7 +180,7 @@ + (*compile-print* (or print *compile-print*)) + (*package* *package*) + (*DEFAULT-PATHNAME-DEFAULTS* #p"") +- (*data* (list (make-array 50 :fill-pointer 0 :adjustable t) nil nil)) ++ (*data* (list nil)) + *init-name* + (*fasd-data* *fasd-data*) + (*error-count* 0)) +@@ -281,10 +281,8 @@ Cannot compile ~a.~%" + (if (consp *split-files*) + (dolist (v (fourth *split-files*)) (t1expr v))) + (unwind-protect +- (do ((form (read *compiler-input* nil eof) +- (read *compiler-input* nil eof)) +- (load-flag (or (eq :defaults *eval-when-defaults*) +- (member 'load *eval-when-defaults*)))) ++ (do ((form (read *compiler-input* nil eof)(read *compiler-input* nil eof)) ++ (load-flag (if *eval-when-defaults* (member 'load *eval-when-defaults*) t))) + (nil) + (cond + ((eq form eof)) +@@ -292,7 +290,7 @@ Cannot compile ~a.~%" + ((maybe-eval nil form))) + (cond + ((and *split-files* (check-end form eof)) +- (setf (fourth *split-files*) (reverse (third *data*))) ++ (setf (fourth *split-files*) nil);(reverse (third *data*)) ;FIXME check this + (return nil)) + ((eq form eof) (return nil)))) + +--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp +@@ -72,7 +72,6 @@ + + + (defvar *top-level-forms* nil) +-(defvar *non-package-operation* nil) + + ;;; *top-level-forms* holds ( { top-level-form }* ). + ;;; +@@ -99,18 +98,7 @@ + + ;;; Package operations. + +-(si:putprop 'make-package t 'package-operation) +-(si:putprop 'in-package t 'package-operation) +-(si:putprop 'shadow t 'package-operation) +-(si:putprop 'shadowing-import t 'package-operation) +-(si:putprop 'export t 'package-operation) +-(si:putprop 'unexport t 'package-operation) +-(si:putprop 'use-package t 'package-operation) +-(si:putprop 'unuse-package t 'package-operation) +-(si:putprop 'import t 'package-operation) +-(si:putprop 'provide t 'package-operation) +-(si:putprop 'require t 'package-operation) +-(si:putprop 'defpackage:defpackage t 'package-operation) ++(si:putprop 'in-package t 'eval-at-compile) + + ;;; Pass 1 top-levels. + +@@ -135,6 +123,7 @@ + ;;; Pass 2 initializers. + + (si:putprop 'defun 't2defun 't2) ++(si:putprop 'progn 't2progn 't2) + (si:putprop 'declare 't2declare 't2) + (si:putprop 'defentry 't2defentry 't2) + (si:putprop 'si:putprop 't2putprop 't2) +@@ -142,6 +131,7 @@ + ;;; Pass 2 C function generators. + + (si:putprop 'defun 't3defun 't3) ++(si:putprop 'progn 't3progn 't3) + (si:putprop 'ordinary 't3ordinary 't3) + (si:putprop 'sharp-comma 't3sharp-comma 't3) + (si:putprop 'clines 't3clines 't3) +@@ -242,15 +232,6 @@ + ((symbolp fun) + (cond ((eq fun 'si:|#,|) + (cmperr "Sharp-comma-macro is in a bad place.")) +- ((get fun 'package-operation) +- (when *non-package-operation* +- (cmpwarn "The package operation ~s was in a bad place." +- form)) +- (let ((res (if (setq fd (macro-function fun)) +- (cmp-expand-macro fd fun (copy-list (cdr form))) +- form))) +- (maybe-eval t res) +- (wt-data-package-operation res))) + ((setq fd (get fun 't1)) + (when *compile-print* (print-current-form)) + (funcall fd args)) +@@ -278,11 +259,24 @@ + (defvar *vaddress-list*) ;; hold addresses of C functions, and other data + (defvar *vind*) ;; index in the VV array where the address is. + (defvar *Inits*) ++ ++(defun t23expr (form prop &aux (def (when (consp form) (get (car form) prop))) ++ *local-funs* (*first-error* t) *vcs-used*) ++ (when def ++ (apply def (cdr form))) ++ (when (eq prop 't3) ++ ;;; Local function and closure function definitions. ++ (block ++ nil ++ (loop ++ (when (endp *local-funs*) (return)) ++ (let (*vcs-used*) ++ (apply 't3local-fun (pop *local-funs*))))))) ++ + (defun ctop-write (name &aux +- def +- (*function-links* nil) *c-vars* (*volatile* " VOL ") +- *vaddress-list* (*vind* 0) *inits* +- *current-form* *vcs-used*) ++ (*function-links* nil) *c-vars* (*volatile* " VOL ") ++ *vaddress-list* (*vind* 0) *inits* ++ *current-form* *vcs-used*) + (declare (special *current-form* *vcs-used*)) + + (setq *top-level-forms* (nreverse *top-level-forms*)) +@@ -295,32 +289,19 @@ + + + ;; write all the inits. +- (dolist* (*current-form* *top-level-forms*) +- (setq *first-error* t) +- (setq *vcs-used* nil) +- (when (setq def (get (car *current-form*) 't2)) +- (apply def (cdr *current-form*)))) +- ++ (dolist (*current-form* *top-level-forms*) ++ (t23expr *current-form* 't2)) + + ;;; C function definitions. +- (dolist* (*current-form* *top-level-forms*) +- (setq *first-error* t) +- (setq *vcs-used* nil) +- (when (setq def (get (car *current-form*) 't3)) +- (apply def (cdr *current-form*)))) +- +- ;;; Local function and closure function definitions. +- (let (lf) +- (block local-fun-process +- (loop +- (when (endp *local-funs*) (return-from local-fun-process)) +- (setq lf (car *local-funs*)) +- (pop *local-funs*) +- (setq *vcs-used* nil) +- (apply 't3local-fun lf)))) ++ (dolist (*current-form* *top-level-forms*) ++ (let* ((inits (data-inits))) ++ (t23expr *current-form* 't3) ++ (unless (or (eq (data-inits) inits) (eq (cdr (data-inits)) inits)) ++ (let ((di (data-inits))) ++ (setf (data-inits) inits) ++ (add-init (cons 'progn (nreverse (mapcar 'cdr (ldiff di inits))))))))) + + ;;; Global entries for directly called functions. +- + (dolist* (x *global-entries*) + (setq *vcs-used* nil) + (apply 'wt-global-entry x)) +@@ -400,31 +381,27 @@ + ;; as I can make it. Valid values of *eval-when-defaults* are + ;; a sublist of '(compile eval load) + +-(defvar *eval-when-defaults* :defaults) +- +-(defun maybe-eval (default-action form) +- (or default-action (and (symbolp (car form)) +- (setq default-action (get (car form) 'eval-at-compile)))) +- (cond ((or (and default-action (eq :defaults *eval-when-defaults*)) +- (and (consp *eval-when-defaults*)(member 'compile *eval-when-defaults* ))) +- (if form (cmp-eval form)) +- t))) ++(defvar *eval-when-defaults* nil);:defaults + ++(defun maybe-eval (def form) ++ (when (or def ++ (intersection '(compile :compile-toplevel) *eval-when-defaults*) ++ (let ((c (car form))) (when (symbolp c) (get c 'eval-at-compile)))) ++ (when form ++ (cmp-eval form)) ++ t)) + + (defun t1eval-when (args &aux load-flag compile-flag) + (when (endp args) (too-few-args 'eval-when 1 0)) +- (dolist** (situation (car args)) ++ (dolist (situation (car args)) + (case situation + ((load :load-toplevel) (setq load-flag t)) + ((compile :compile-toplevel) (setq compile-flag t)) + ((eval :execute)) +- (otherwise (cmperr "The EVAL-WHEN situation ~s is illegal." +- situation)))) +- (let ((*eval-when-defaults* (car args))) +- (cond (load-flag +- (t1progn (cdr args))) +- (compile-flag +- (cmp-eval (cons 'progn (cdr args))))))) ++ (otherwise (cmperr "The EVAL-WHEN situation ~s is illegal." situation)))) ++ (let ((*eval-when-defaults* (or *eval-when-defaults* (car args)))) ++ (cond (load-flag (t1progn (cdr args))) ++ (compile-flag (cmp-eval (cons 'progn (cdr args))))))) + + (defun t1macrolet(args &aux (*funs* *funs*)) + (dolist (def (car args)) +@@ -441,7 +418,17 @@ + (let ((*compile-ordinaries* t)) + (t1progn (cdr args)))) + (t +- (dolist** (form args) (t1expr form))))) ++ (let ((f *top-level-forms*)) ++ (dolist (form args) (t1expr form)) ++ (setq *top-level-forms* (cons `(progn ,(nreverse (ldiff *top-level-forms* f))) f)))))) ++ ++(defun t3progn (args) ++ (dolist (arg args) ++ (t23expr arg 't3))) ++ ++(defun t2progn (args) ++ (dolist (arg args) ++ (t23expr arg 't2))) + + ;; (defun foo (x) .. -> (defun foo (g102 &aux (x g102)) ... + (defun cmpfix-args (args bind &aux tem (lam (copy-list (second args)))) +@@ -464,7 +451,6 @@ + (unless (macro-function (car args)) (maybe-eval nil (cons 'defun args))) + (tagbody + top +- (setq *non-package-operation* t) + (setq *local-functions* nil) + (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) lambda-expr + (*special-binding* nil) +@@ -681,8 +667,8 @@ + (push (list a) *vaddress-list*) + (prog1 *vind* (incf *vind*))) + +-(defun t2defun (fname cfun lambda-expr doc sp) +- (declare (ignore cfun lambda-expr doc sp)) ++(defun t2defun (fname cfun lambda-expr doc sp &optional macro-p) ++ (declare (ignore cfun lambda-expr doc sp macro-p)) + (cond ((get fname 'no-global-entry)(return-from t2defun nil))) + (cond ((< *space* 2) + (setf (get fname 'debug-prop) t) +@@ -716,8 +702,7 @@ + (t (wt-h cfun "();") + (add-init `(si::mf ',fname ,(add-address (c-function-name "" cfun fname))))))) + +-(defun t3defun (fname cfun lambda-expr doc sp &aux inline-info +- (macro-p (equal `(mflag ,fname) (cadr (member *current-form* *top-level-forms*)))) ++(defun t3defun (fname cfun lambda-expr doc sp &optional macro-p &aux inline-info + (*current-form* (list 'defun fname)) + (*volatile* (volatile (second lambda-expr))) + *downward-closures*) +@@ -1333,47 +1318,29 @@ + (maybe-eval (not (macro-function n)) (cons 'defmacro w));FIXME? + (t1expr `(defun ,n ,@(if macp args (cddr (caddr (si::defmacro* n (pop args) args)))))) + (setf (symbol-plist n) l) +- (push `(mflag ,n) *top-level-forms*)) ++ (nconc (car *top-level-forms*) '(t))) ++ ++(defvar *compiling-ordinary* nil) + +-(defun t1ordinary (form &aux tem ) +- (setq *non-package-operation* t) +- ;; check for top level functions +- (cond ((or *compile-ordinaries* (when (listp form) (member (car form) '(let let* flet labels)))) ++(defun compile-ordinary-p (form) ++ (when (consp form) ++ (or (member (car form) '(lambda defun defmacro flet labels)) ++ (compile-ordinary-p (car form)) ++ (compile-ordinary-p (cdr form))))) ++ ++(defun t1ordinary (form) ++ (cond ((unless *compiling-ordinary* ++ (or *compile-ordinaries* (compile-ordinary-p form))) + (maybe-eval nil form) +- (let ((gen (gensym "progn 'compile"))) ++ (let ((gen (gensym))(*compiling-ordinary* t)) + (proclaim `(function ,gen nil t)) +- (t1expr `(defun ,gen (), form nil)) +- (push (list 'ordinary `(,gen) ) *top-level-forms*))) +- ;;Hack to things like (setq bil #'(lambda () ...)) or (foo nil #'(lambda () ..)) +- ;; but not (let ((x ..)) (setq bil #'(lambda () ..))) +- ;; for the latter you must use (progn 'compile ...) +- ((and (consp form) +- (symbolp (car form)) +- (or (eq (car form) 'setq) +- (not (special-operator-p (car form)))) +- (do ((v (cdr form) (and (consp v) (cdr v))) +- (i 1 (the fixnum (+ 1 i)))) +- ((or (>= i 1000) +- (not (consp v))) nil) +- (declare (fixnum i)) +- (cond ((and (consp (car v)) +- (eq (caar v) 'function) +- (consp (setq tem (second (car v)))) +- (eq (car tem) 'lambda)) +- (let ((gen (gensym))) +- (t1expr `(defun ,gen ,@ (cdr tem))) +- (return-from t1ordinary +- (t1ordinary (append +- (subseq form 0 i) +- `((symbol-function ', gen)) +- (nthcdr (+ 1 i) form)))))))))) ++ (t1expr `(progn (defun ,gen nil ,form nil) (,gen))))) + (t + (maybe-eval nil form) + (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) + (*sharp-commas* nil)) + (push (list 'ordinary form) *top-level-forms*) +- nil +- )))) ++ nil)))) + + (defun t3ordinary (form) + (cond ((atom form)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp +@@ -217,7 +217,7 @@ + (dolist (v '(si::cdefn lfun inline-safe inline-unsafe + inline-always c1conditional c2 c1 c1+ co1 + si::structure-access co1special +- top-level-macro t3 t2 t1 package-operation)) ++ top-level-macro t3 t2 t1)) + (si::putprop v t 'compiler-prop )) + + (defun compiler-def-hook (symbol code) symbol code nil) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp +@@ -25,9 +25,7 @@ + (require 'FASDMACROS "../cmpnew/gcl_fasdmacros.lsp") + + +-(defmacro data-vector () `(car *data*)) +-(defmacro data-inits () `(second *data*)) +-(defmacro data-package-ops () `(third *data*)) ++(defmacro data-inits () `(first *data*)) + + ) + +@@ -69,7 +67,7 @@ + (defvar *fasd-data*) + + (defvar *hash-eq* nil) +-(defvar *run-hash-equal-data-checking* nil) ++(defvar *run-hash-equal-data-checking* t) + (defun memoized-hash-equal (x depth);FIXME implement all this in lisp + (declare (fixnum depth)) + (when *run-hash-equal-data-checking* +@@ -85,7 +83,6 @@ + (si::hash-equal x depth))))))) + + (defun push-data-incf (x) +- (vector-push-extend (cons (memoized-hash-equal x -1000) x) (data-vector)) + (incf *next-vv*)) + + (defun wt-data1 (expr) +@@ -105,58 +102,36 @@ + (terpri *compiler-output-data*) + (prin1 expr *compiler-output-data*))) + +-(defun verify-data-vector(vec &aux v) +- (dotimes (i (length vec)) +- (setq v (aref vec i)) +- (let ((has (memoized-hash-equal (cdr v) -1000))) +- (cond ((not (eql (car v) has)) +- (cmpwarn "A form or constant:~% ~s ~%has changed during the eval compile procedure!.~% The changed form will be the one put in the compiled file" (cdr v))))) +- (setf (aref vec i) (cdr v))) +- vec +- ) ++(defun add-init (x &optional endp &aux (tem (cons (memoized-hash-equal x -1000) x))) ++ (if endp ++ (nconc (data-inits) (list tem)) ++ (push tem (data-inits))) ++ x) ++ ++(defun verify-datum (v) ++ (unless (eql (pop v) (memoized-hash-equal v -1000)) ++ (cmpwarn "A form or constant:~% ~s ~%has changed during the eval compile procedure!.~% The changed form will be the one put in the compiled file" v)) ++ v) ++ ++(defun wt-fasd-element (x) ++ (si::find-sharing-top x (fasd-table (car *fasd-data*))) ++ (si::write-fasd-top x (car *fasd-data*))) + +-(defun add-init (x &optional endp) +- (let ((tem (cons (memoized-hash-equal x -1000) x))) +- (setf (data-inits) +- (if endp +- (nconc (data-inits) (list tem)) +- (cons tem (data-inits) ))) +- x)) ++(defun wt-data2 (x) ++ (if *fasd-data* ++ (wt-fasd-element x) ++ (wt-data1 x))) + +-(defun wt-data-file () ++(defun wt-data-file nil + (when *prof-p* (add-init `(si::mark-memory-as-profiling))) +- (verify-data-vector (data-vector)) +- (let* ((vec (coerce (nreverse (data-inits)) 'vector))) +- (verify-data-vector vec) +- (setf (aref (data-vector) (- (length (data-vector)) 1)) +- (cons 'si::%init vec)) +- (setf (data-package-ops) (nreverse (data-package-ops))) +- (cond (*fasd-data* +- (wt-fasd-data-file)) +- (t +- (format *compiler-output-data* " ~%#(") +- (dolist (v (data-package-ops)) +- (format *compiler-output-data* "#! ") +- (wt-data1 v)) +- (wt-data1 (data-vector)) +- (format *compiler-output-data* "~%)~%") +- )))) ++ (wt-data2 (1+ *next-vv*)) ++ (dolist (v (nreverse (data-inits))) ++ (wt-data2 (verify-datum v))) ++ (when *fasd-data* ++ (si::close-fasd (car *fasd-data*)))) + +-(defun wt-fasd-data-file ( &aux (x (data-vector)) tem) +-; (si::find-sharing-top (data-package-ops) (fasd-table (car *fasd-data*))) +- (si::find-sharing-top x (fasd-table (car *fasd-data*))) +- (cond ((setq tem (data-package-ops)) +- (dolist (v tem) +- (put-op d_eval_skip *compiler-output-data*) +- (si::write-fasd-top v (car *fasd-data*))))) +- (si::write-fasd-top x (car *fasd-data*)) +-; (sloop::sloop for (k v) in-table (fasd-table (car *fasd-data*)) +-; when (>= v 0) do (print (list k v))) +- (si::close-fasd (car *fasd-data*))) + (defun wt-data-begin ()) + (defun wt-data-end ()) +-(defun wt-data-package-operation (x) +- (push x (data-package-ops))) + + (defmacro wt (&rest forms &aux (fl nil)) + (dolist** (form forms (cons 'progn (reverse (cons nil fl)))) +--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp ++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp +@@ -2,197 +2,163 @@ + (COMMON-LISP::IN-PACKAGE "COMPILER") + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- COMPILER::TAG-REF-CLB COMPILER::SET-TOP +- COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1LIST-NTH +- COMPILER::C1RPLACA-NTHCDR COMPILER::C1DEFINE-STRUCTURE +- COMPILER::BLK-REF-CLB COMPILER::WT-VV COMPILER::C1LENGTH +- COMPILER::C1MAPC COMPILER::C1LOCAL-CLOSURE +- COMPILER::CHECK-VREF COMPILER::WT-VAR-DECL COMPILER::C1TAGBODY +- COMPILER::BLK-REF-CCB COMPILER::C1LOAD-TIME-VALUE +- COMPILER::C1ASH COMPILER::FUN-LEVEL COMPILER::COPY-INFO +- COMPILER::INLINE-POSSIBLE COMPILER::WT-VS-BASE +- COMPILER::T1DEFENTRY COMPILER::CHARACTER-LOC-P +- COMPILER::C2RPLACA COMPILER::RESET-INFO-TYPE +- COMPILER::TYPE-FILTER COMPILER::TAG-SWITCH +- COMPILER::DECL-BODY-SAFETY COMPILER::C1AND +- COMPILER::C1FMLA-CONSTANT COMPILER::C2GO-CLB +- COMPILER::C1FUNCTION COMPILER::C1MAPLIST COMPILER::VAR-TYPE +- COMPILER::CLINK COMPILER::UNWIND-NO-EXIT COMPILER::VAR-LOC +- COMPILER::C2RPLACD COMPILER::VERIFY-DATA-VECTOR +- COMPILER::TAG-REF-CCB COMPILER::C1RETURN-FROM +- COMPILER::T1DEFINE-STRUCTURE COMPILER::MDELETE-FILE +- COMPILER::OBJECT-TYPE COMPILER::WT-CAR COMPILER::TAG-P +- COMPILER::ADD-LOOP-REGISTERS COMPILER::C1MEMQ +- COMPILER::C2FUNCTION COMPILER::CMP-MACRO-FUNCTION +- COMPILER::C1BOOLE-CONDITION COMPILER::REP-TYPE COMPILER::C2GET +- COMPILER::C2VAR COMPILER::C2EXPR* COMPILER::C1ADD-GLOBALS +- COMPILER::WT1 COMPILER::C1BLOCK COMPILER::C1MAPL +- COMPILER::C1MAPCAR COMPILER::FSET-FN-NAME COMPILER::C2GO-CCB +- COMPILER::T1DEFLA COMPILER::C1NTH-CONDITION +- COMPILER::ADD-OBJECT2 COMPILER::VAR-NAME COMPILER::C1EXPR +- COMPILER::FUN-REF COMPILER::SCH-LOCAL-FUN +- COMPILER::FIXNUM-LOC-P COMPILER::BLK-VAR +- COMPILER::C1UNWIND-PROTECT COMPILER::C2BIND +- COMPILER::PARSE-CVSPECS COMPILER::C1NTH +- COMPILER::WT-SWITCH-CASE SYSTEM::UNDEF-COMPILER-MACRO +- COMPILER::SET-UP-VAR-CVS COMPILER::C1ECASE +- COMPILER::C1STRUCTURE-REF COMPILER::FUN-INFO +- COMPILER::C1MEMBER COMPILER::C1GET COMPILER::WT-FUNCTION-LINK +- COMPILER::C1ASH-CONDITION COMPILER::WT-CCB-VS COMPILER::INFO-P +- COMPILER::REGISTER COMPILER::TAG-VAR COMPILER::C1VAR +- COMPILER::C1TERPRI COMPILER::LTVP +- COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1MAPCON +- COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1SETQ +- COMPILER::C2DOWNWARD-FUNCTION COMPILER::T3ORDINARY +- COMPILER::C1VREF COMPILER::WT-VS COMPILER::CONSTANT-FOLD-P +- COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-EXIT +- COMPILER::T1DEFUN COMPILER::C1LABELS COMPILER::C1FSET +- COMPILER::T1MACROLET COMPILER::FUN-NAME COMPILER::C1APPLY +- COMPILER::FUN-P COMPILER::WT-DATA-PACKAGE-OPERATION +- COMPILER::C1FUNOB COMPILER::WT-SYMBOL-FUNCTION +- COMPILER::GET-RETURN-TYPE COMPILER::ADD-CONSTANT +- COMPILER::SAFE-SYSTEM COMPILER::BLK-VALUE-TO-GO +- COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C2TAGBODY-LOCAL +- COMPILER::C1DECLARE COMPILER::C1OR COMPILER::C1ASSOC +- COMPILER::ADD-ADDRESS COMPILER::VAR-KIND +- COMPILER::PROCLAMATION COMPILER::FIX-OPT COMPILER::WT-DATA1 +- COMPILER::INFO-SP-CHANGE COMPILER::ARGS-CAUSE-SIDE-EFFECT +- COMPILER::WRITE-BLOCK-OPEN COMPILER::C2TAGBODY-BODY +- COMPILER::CONS-TO-LISTA COMPILER::SAVE-FUNOB COMPILER::VAR-REF +- COMPILER::C1LOCAL-FUN COMPILER::VAR-REP-LOC +- COMPILER::SET-PUSH-CATCH-FRAME COMPILER::CTOP-WRITE +- COMPILER::C2TAGBODY-CLB COMPILER::T1CLINES +- COMPILER::ADD-OBJECT COMPILER::GET-LOCAL-RETURN-TYPE +- COMPILER::DEFAULT-INIT COMPILER::FUNCTION-ARG-TYPES +- COMPILER::C1STRUCTURE-SET COMPILER::CMP-MACROEXPAND-1 +- COMPILER::INLINE-TYPE COMPILER::VAR-REGISTER +- COMPILER::DECLARATION-TYPE COMPILER::C1CATCH COMPILER::C1LET +- COMPILER::T3CLINES COMPILER::UNDEFINED-VARIABLE COMPILER::C1GO +- COMPILER::TAG-NAME COMPILER::SCH-GLOBAL COMPILER::C1IF +- COMPILER::C1FLET COMPILER::INLINE-BOOLE3-STRING +- COMPILER::INFO-CHANGED-ARRAY COMPILER::C2FUNCALL-AUX +- COMPILER::FUN-REF-CCB COMPILER::WT-CADR COMPILER::FUN-CFUN +- COMPILER::WT-VS* COMPILER::WT-DOWN COMPILER::C2GETHASH +- COMPILER::ADD-REG1 COMPILER::REPLACE-CONSTANT +- COMPILER::C2DM-RESERVE-V COMPILER::RESULT-TYPE +- COMPILER::C1FUNCALL COMPILER::C1THE COMPILER::VARARG-P +- COMPILER::INFO-REFERRED-ARRAY COMPILER::C1PROGV +- COMPILER::T2DECLARE COMPILER::T1DEFCFUN COMPILER::C2VALUES +- COMPILER::C1SWITCH COMPILER::C1MAPCAN +- COMPILER::CMP-MACROEXPAND COMPILER::TAG-LABEL +- COMPILER::TAG-UNWIND-EXIT COMPILER::C1PRINC COMPILER::C1THROW +- COMPILER::SAVE-AVMA COMPILER::VOLATILE COMPILER::FLAGS-POS +- COMPILER::INFO-TYPE COMPILER::C1NTHCDR-CONDITION +- COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::WT-FUNCALL-C +- COMPILER::PUSH-ARGS COMPILER::C1DM-BAD-KEY +- COMPILER::T1ORDINARY COMPILER::C1PSETQ COMPILER::BLK-REF +- COMPILER::C2DM-RESERVE-VL COMPILER::C1MACROLET +- COMPILER::C1SHARP-COMMA COMPILER::C1RPLACA +- COMMON-LISP::PROCLAIM COMPILER::PUSH-DATA-INCF +- COMPILER::MACRO-DEF-P COMPILER::BLK-NAME COMPILER::C1VALUES +- COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1DEFMACRO +- COMPILER::GET-ARG-TYPES COMPILER::ADD-SYMBOL +- COMPILER::NAME-SD1 COMPILER::C2GO-LOCAL +- COMPILER::C2TAGBODY-CCB COMPILER::WT-LIST +- COMPILER::GET-LOCAL-ARG-TYPES COMPILER::C1BOOLE3 +- COMPILER::C1STACK-LET COMPILER::WT-CDR COMPILER::C1QUOTE +- COMPILER::C1EVAL-WHEN COMPILER::VAR-P COMPILER::CHECK-DOWNWARD +- COMPILER::T1PROGN COMPILER::BLK-P COMPILER::C2LOCATION +- COMPILER::THE-PARAMETER COMPILER::C2VAR-KIND +- COMPILER::C1GETHASH COMPILER::LTVP-EVAL COMPILER::C1RPLACD +- COMPILER::INFO-VOLATILE COMPILER::LONG-FLOAT-LOC-P +- COMPILER::FUNCTION-RETURN-TYPE COMPILER::SHORT-FLOAT-LOC-P +- COMPILER::WT-H1 COMPILER::C1MULTIPLE-VALUE-CALL +- COMPILER::NAME-TO-SD COMPILER::C1PROGN COMPILER::SET-RETURN +- COMPILER::C1LET* COMPILER::AET-C-TYPE COMPILER::C1COMPILER-LET +- COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::VV-STR +- COMPILER::C1NTHCDR COMPILER::TAG-REF COMPILER::GET-INCLUDED)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- COMPILER::INLINE-BOOLE3)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) ++ COMPILER::CMPERR COMPILER::CMPWARN COMPILER::WT-CVAR ++ COMPILER::ADD-INIT COMPILER::INIT-NAME ++ COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::C1CASE ++ COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE ++ COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT ++ COMPILER::C1LAMBDA-EXPR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::T) +- COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::WT-IF-PROCLAIMED +- COMPILER::MY-CALL COMPILER::WT-GLOBAL-ENTRY +- COMPILER::T3DEFUN-NORMAL COMPILER::C2STRUCTURE-REF +- COMPILER::C2SWITCH COMPILER::C2CALL-GLOBAL +- COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::C2RETURN-LOCAL COMPILER::WT-INLINE-LOC ++ COMPILER::C1SYMBOL-FUN COMPILER::C2DECL-BODY ++ COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES ++ COMPILER::C2BLOCK COMPILER::C1BODY COMPILER::C2BLOCK-LOCAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- COMPILER::LINK COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL +- COMPILER::INLINE-ARGS)) ++ COMPILER::MEMOIZED-HASH-EQUAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- COMPILER::WT-INLINE-INTEGER COMPILER::ADD-FUNCTION-DECLARATION +- COMPILER::C1STRUCTURE-REF1 COMPILER::ADD-FAST-LINK +- COMPILER::AND-FORM-TYPE COMPILER::C2PRINC COMPILER::C2MAPCAN +- COMPILER::CJT COMPILER::C2CASE COMPILER::WT-INLINE-LONG-FLOAT +- COMPILER::SUBLIS1-INLINE COMPILER::MYSUB +- COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::FIX-DOWN-ARGS +- COMPILER::TOO-MANY-ARGS COMPILER::CMP-EXPAND-MACRO +- COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2GO +- COMPILER::WT-INLINE-FIXNUM COMPILER::WT-INLINE-COND +- COMPILER::C1MAP-FUNCTIONS COMPILER::C1DM +- COMPILER::WT-MAKE-CCLOSURE COMPILER::CAN-BE-REPLACED* +- COMPILER::C-FUNCTION-NAME COMPILER::C2LET* COMPILER::CJF +- COMPILER::TOO-FEW-ARGS COMPILER::BOOLE3 COMPILER::T3DEFCFUN +- COMPILER::C2FUNCALL-SFUN COMPILER::C2MAPC +- COMPILER::CHECK-FORM-TYPE COMPILER::SET-VAR +- COMPILER::C2TAGBODY COMPILER::CHECK-VDECL +- COMPILER::GET-INLINE-INFO COMPILER::ASSIGN-DOWN-VARS +- COMPILER::C2LET COMPILER::INLINE-TYPE-MATCHES +- COMPILER::COMPILER-PASS2 COMPILER::C2PROGV COMPILER::C2MAPCAR +- COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-CHARACTER +- COMPILER::WT-INLINE-SHORT-FLOAT)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ COMPILER::MAKE-INIT-STRING)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- COMPILER::T2DEFENTRY COMPILER::DEFSYSFUN COMPILER::T3DEFENTRY)) ++ COMPILER::MLIN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- COMPILER::T3DEFUN-LOCAL-ENTRY COMPILER::T3INIT-FUN +- COMPILER::T2DEFUN COMPILER::T3DEFUN COMPILER::C2STRUCTURE-SET +- COMPILER::C1APPLY-OPTIMIZE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS ++ COMPILER::ANALYZE-REGS1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::T) +- COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ COMPILER::DECL-BODY-SAFETY COMPILER::C2FUNCTION ++ COMPILER::C1PROGN COMPILER::C1MAPCAR COMPILER::C1FLET ++ COMPILER::C1EXPR COMPILER::C1LET COMPILER::ADD-OBJECT ++ COMPILER::C1LABELS COMPILER::C1FMLA-CONSTANT COMPILER::C1ECASE ++ COMPILER::C1LENGTH COMPILER::C1APPLY COMPILER::THE-PARAMETER ++ COMPILER::C1TAGBODY COMPILER::T3CLINES ++ COMPILER::VERIFY-DATA-VECTOR COMPILER::VAR-KIND ++ COMPILER::INLINE-TYPE COMPILER::C1MULTIPLE-VALUE-CALL ++ COMPILER::C2GET COMPILER::ADD-CONSTANT COMPILER::T1DEFMACRO ++ COMPILER::C2EXPR* COMPILER::TAG-UNWIND-EXIT ++ COMPILER::CHECK-DOWNWARD COMPILER::WT-CADR ++ COMPILER::CHARACTER-LOC-P COMPILER::C1DECLARE ++ COMPILER::AET-C-TYPE COMPILER::C1QUOTE COMPILER::CHECK-VREF ++ COMPILER::VAR-LOC COMPILER::INLINE-POSSIBLE COMPILER::SET-TOP ++ COMPILER::T1ORDINARY COMPILER::BLK-VAR COMPILER::SAVE-AVMA ++ COMPILER::C1VREF COMPILER::WT-VV COMPILER::C2GO-LOCAL ++ COMPILER::C1MEMBER COMPILER::LTVP-EVAL COMPILER::VV-STR ++ COMPILER::TAG-REF-CLB COMPILER::T2DECLARE ++ COMPILER::CMP-MACROEXPAND-1 COMPILER::T1DEFINE-STRUCTURE ++ COMPILER::T1DEFENTRY COMPILER::ADD-OBJECT2 COMPILER::FUN-LEVEL ++ COMPILER::VAR-P COMPILER::WT-DATA-PACKAGE-OPERATION ++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1PSETQ COMPILER::C1OR ++ COMPILER::C1LOCAL-FUN COMPILER::WT-VS-BASE ++ COMPILER::DEFAULT-INIT COMPILER::C1MAPCON COMPILER::C1GO ++ COMPILER::INFO-REFERRED-ARRAY COMPILER::BLK-REF ++ COMPILER::T1DEFLA COMPILER::INFO-CHANGED-ARRAY ++ COMPILER::WT-VAR-DECL COMPILER::UNWIND-NO-EXIT ++ COMPILER::BLK-VALUE-TO-GO COMPILER::C2GO-CLB ++ COMPILER::FUNCTION-ARG-TYPES COMPILER::C1MAPC ++ COMPILER::C2DOWNWARD-FUNCTION COMPILER::CMP-MACRO-FUNCTION ++ COMPILER::C1SHARP-COMMA COMPILER::ADD-ADDRESS ++ COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::T1DEFUN ++ COMPILER::C1ADD-GLOBALS COMPILER::C2DM-RESERVE-V ++ COMPILER::C1ASH COMPILER::C1STACK-LET ++ COMPILER::WT-SYMBOL-FUNCTION COMPILER::C2TAGBODY-CLB ++ COMPILER::C1MAPLIST COMPILER::PUSH-DATA-INCF ++ COMPILER::C2TAGBODY-LOCAL COMPILER::C1FSET COMPILER::WT1 ++ COMPILER::VAR-REF-CCB COMPILER::INFO-P COMPILER::C1ASSOC ++ COMPILER::C2GETHASH COMPILER::C1RPLACD COMPILER::C1EVAL-WHEN ++ COMPILER::REP-TYPE COMPILER::C1FUNOB COMPILER::BLK-REF-CLB ++ COMPILER::WT-VS* COMPILER::C1GET COMPILER::SCH-LOCAL-FUN ++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::C1BOOLE3 ++ COMPILER::BLK-EXIT COMPILER::T1DEFCFUN COMPILER::GET-ARG-TYPES ++ COMPILER::WRITE-BLOCK-OPEN COMPILER::C1COMPILER-LET ++ COMPILER::ADD-LOOP-REGISTERS COMPILER::INLINE-BOOLE3-STRING ++ COMPILER::C1LOAD-TIME-VALUE COMPILER::VAR-TYPE ++ COMPILER::REGISTER COMPILER::RESET-INFO-TYPE ++ COMPILER::C1UNWIND-PROTECT COMPILER::C1IF ++ COMPILER::SHORT-FLOAT-LOC-P COMPILER::C1VAR ++ COMPILER::WT-FUNCALL-C COMPILER::C1THE COMPILER::FIX-OPT ++ COMPILER::UNDEFINED-VARIABLE COMPILER::C2RPLACD ++ COMPILER::C1BOOLE-CONDITION COMPILER::C1NTH COMPILER::VARARG-P ++ COMPILER::OBJECT-TYPE COMPILER::VOLATILE COMPILER::FUN-P ++ COMPILER::VAR-REF COMPILER::C1DEFINE-STRUCTURE ++ COMPILER::MAXARGS COMPILER::LONG-FLOAT-LOC-P ++ COMPILER::REPLACE-CONSTANT COMPILER::C2TAGBODY-BODY ++ COMPILER::TAG-P COMPILER::C1RETURN-FROM COMPILER::WT-VS ++ COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::C1LIST-NTH ++ COMPILER::FSET-FN-NAME COMPILER::SAVE-FUNOB COMPILER::C1BLOCK ++ COMPILER::C1AND COMPILER::C2TAGBODY-CCB COMPILER::GET-INCLUDED ++ COMPILER::TAG-REF COMPILER::NEED-TO-SET-VS-POINTERS ++ COMPILER::C1VALUES COMPILER::BLK-P COMPILER::COPY-INFO ++ COMPILER::WT-CAR COMPILER::FUN-CFUN ++ COMPILER::C1MULTIPLE-VALUE-PROG1 SYSTEM::UNDEF-COMPILER-MACRO ++ COMPILER::C1DM-BAD-KEY COMPILER::FUN-REF COMPILER::NAME-SD1 ++ COMPILER::MDELETE-FILE COMPILER::SAFE-SYSTEM ++ COMPILER::WT-DATA2 COMPILER::WT-CDR COMPILER::C2GO-CCB ++ COMPILER::C1ASH-CONDITION COMPILER::C1RPLACA ++ COMPILER::WT-DATA1 COMPILER::C1RPLACA-NTHCDR ++ COMPILER::NAME-TO-SD COMPILER::WT-LIST ++ COMPILER::CMP-MACROEXPAND COMPILER::WT-SWITCH-CASE ++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::SET-UP-VAR-CVS ++ COMPILER::WT-FASD-ELEMENT COMPILER::RESULT-TYPE ++ COMPILER::C1SWITCH COMPILER::FIXNUM-LOC-P ++ COMPILER::C1NTHCDR-CONDITION COMPILER::TAG-VAR ++ COMPILER::C1NTHCDR COMPILER::CLINK COMPILER::LTVP ++ COMPILER::C1LET* COMPILER::TAG-NAME COMPILER::C1FUNCALL ++ COMPILER::C2RPLACA COMPILER::MACRO-DEF-P ++ COMPILER::C1STRUCTURE-REF COMPILER::GET-RETURN-TYPE ++ COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1CLINES ++ COMPILER::TYPE-FILTER COMPILER::C1FUNCTION ++ COMPILER::CONS-TO-LISTA COMPILER::C1NTH-CONDITION ++ COMPILER::FUN-NAME COMPILER::PROCLAMATION COMPILER::VAR-NAME ++ COMPILER::WT-CCB-VS COMPILER::FLAGS-POS COMPILER::C1CATCH ++ COMPILER::CTOP-WRITE COMPILER::TAG-LABEL COMPILER::C1MEMQ ++ COMPILER::C1GETHASH COMPILER::TAG-REF-CCB COMPILER::TAG-SWITCH ++ COMPILER::C2BIND COMPILER::VERIFY-DATUM COMPILER::C1MAPCAN ++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1TERPRI ++ COMPILER::FUN-REF-CCB COMMON-LISP::PROCLAIM ++ COMPILER::INFO-VOLATILE COMPILER::T3ORDINARY ++ COMPILER::C2LOCATION COMPILER::BLK-NAME ++ COMPILER::C1STRUCTURE-SET COMPILER::C2VAR ++ COMPILER::C1LOCAL-CLOSURE COMPILER::C1MACROLET ++ COMPILER::WT-FUNCTION-LINK COMPILER::C2VALUES ++ COMPILER::T1MACROLET COMPILER::C1MULTIPLE-VALUE-BIND ++ COMPILER::C2FUNCALL-AUX COMPILER::C1MULTIPLE-VALUE-SETQ ++ COMPILER::PUSH-ARGS COMPILER::BLK-REF-CCB COMPILER::C1SETQ ++ COMPILER::ADD-SYMBOL COMPILER::C2VAR-KIND COMPILER::C1THROW ++ COMPILER::DECLARATION-TYPE COMPILER::C1PROGV ++ COMPILER::INFO-TYPE COMPILER::CONSTANT-FOLD-P ++ COMPILER::C1PRINC COMPILER::WT-DOWN COMPILER::SCH-GLOBAL ++ COMPILER::T1PROGN COMPILER::INFO-SP-CHANGE ++ COMPILER::C2DM-RESERVE-VL COMPILER::C1MAPL ++ COMPILER::FUNCTION-RETURN-TYPE COMPILER::ADD-REG1 ++ COMPILER::PARSE-CVSPECS COMPILER::FUN-INFO ++ COMPILER::VAR-REGISTER COMPILER::SET-RETURN COMPILER::WT-H1 ++ COMPILER::VAR-REP-LOC)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- COMPILER::T3LOCAL-DCFUN COMPILER::T3LOCAL-FUN)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ COMPILER::INLINE-BOOLE3)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -206,8 +172,8 @@ + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) +- COMPILER::C2RETURN-FROM COMPILER::C2DM COMPILER::C1DM-VL +- COMPILER::C2APPLY-OPTIMIZE COMPILER::C1DM-V)) ++ COMPILER::C1DM-V COMPILER::C1DM-VL COMPILER::C2APPLY-OPTIMIZE ++ COMPILER::C2RETURN-FROM COMPILER::C2DM)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -216,40 +182,85 @@ + COMPILER::T3DEFUN-AUX)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC +- COMPILER::WT-CHARACTER-LOC COMPILER::WT-TO-STRING +- COMPILER::WT-LOC COMPILER::MEXPAND-DEFTYPE +- COMPILER::CMP-TOPLEVEL-EVAL COMPILER::T1EVAL-WHEN +- COMPILER::T1EXPR COMPILER::C2OR COMPILER::WT-FIXNUM-LOC +- COMPILER::C2EXPR COMPILER::C2AND COMPILER::CMP-EVAL +- COMPILER::SET-LOC COMPILER::WT-SHORT-FLOAT-LOC)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE +- COMPILER::LIST-INLINE COMPILER::LIST*-INLINE +- COMPILER::COMPILER-COMMAND COMPILER::MAKE-BLK +- COMPILER::MAKE-FUN COMPILER::WT-CLINK COMPILER::C2FSET +- COMPILER::MAKE-TAG COMPILER::CS-PUSH COMPILER::MAKE-VAR +- COMMON-LISP::COMPILE-FILE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) + COMPILER::F-TYPE)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(COMMON-LISP::DISASSEMBLE COMPILER::CMP-TMP-MACRO +- COMPILER::CMP-ANON COMMON-LISP::COMPILE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::COPY-ARRAY)) ++ COMPILER::C2RETURN-CCB ++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES ++ COMPILER::DO-CHANGED COMPILER::CO1STRUCTURE-PREDICATE ++ COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::CMPFIX-ARGS ++ COMPILER::T3SHARP-COMMA COMPILER::FLAGS ++ COMPILER::CO1WRITE-BYTE COMPILER::CHECK-FNAME-ARGS ++ COMPILER::C2ASSOC!2 COMPILER::CK-SPEC ++ COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::ADD-DEBUG-INFO ++ COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::PRIN1-CMP ++ COMPILER::PUSH-CHANGED-VARS COMPILER::SHIFT>> ++ COMPILER::ARGS-INFO-REFERRED-VARS ++ COMPILER::C2MULTIPLE-VALUE-CALL ++ COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::CO1SCHAR ++ COMPILER::NEXT-CVAR COMPILER::C2RETURN-CLB ++ COMPILER::CO1WRITE-CHAR COMPILER::SET-VS SYSTEM::SWITCH ++ COMPILER::FLAG-P COMPILER::DO-ARRAY COMPILER::INLINE-PROC ++ COMPILER::CO1CONS COMPILER::C2EXPR-TOP ++ COMPILER::CHANGED-LENGTH COMPILER::C2MULTIPLE-VALUE-PROG1 ++ COMPILER::REMOVE-FLAG COMPILER::CO1SUBLIS COMPILER::ADD-INFO ++ COMPILER::C2BIND-INIT COMPILER::C2DM-BIND-VL COMPILER::C1FMLA ++ COMPILER::C2CATCH COMPILER::WT-MAKE-DCLOSURE ++ COMPILER::UNWIND-BDS COMPILER::IS-REP-REFERRED ++ COMPILER::WT-LONG-FLOAT-VALUE COMPILER::WT-GO ++ COMPILER::FAST-READ COMPILER::WT COMPILER::SAFE-COMPILE ++ COMPILER::WT-H COMPILER::STRUCT-TYPE-OPT ++ COMPILER::REFERRED-LENGTH COMPILER::TYPE-AND COMPILER::C2THROW ++ COMPILER::NEED-TO-PROTECT COMPILER::COERCE-LOC ++ COMPILER::TYPE>= COMPILER::WT-NL1 COMPILER::CHECK-END ++ COMPILER::C2BLOCK-CCB COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY ++ COMPILER::SET-BDS-BIND COMPILER::C2DM-BIND-INIT ++ COMPILER::CAN-BE-REPLACED COMPILER::MAYBE-EVAL ++ COMPILER::WT-VAR COMPILER::WT-REQUIREDS ++ COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::CO1TYPEP ++ COMPILER::C1DECL-BODY COMPILER::DOWNWARD-FUNCTION ++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::NEXT-CFUN ++ SYSTEM::SWITCH-FINISH COMPILER::CO1READ-CHAR ++ COMPILER::COMPILER-CC COMPILER::C1PROGN* ++ COMPILER::C1LAMBDA-FUN COMPILER::MAKE-USER-INIT ++ COMPILER::SHIFT<< COMPILER::C1ARGS COMPILER::CK-VL ++ COMPILER::T23EXPR COMPILER::IS-CHANGED COMPILER::PUSH-REFERRED ++ COMPILER::WT-CHARACTER-VALUE ++ COMPILER::PUSH-REFERRED-WITH-START COMPILER::NEXT-LABEL* ++ COMPILER::CMPCK COMPILER::C2DM-BIND-LOC ++ COMPILER::WT-SHORT-FLOAT-VALUE ++ COMPILER::PUSH-CHANGED-WITH-START COMPILER::C2EXPR-TOP* ++ COMPILER::DOLIST* COMPILER::WT-LABEL COMPILER::PUSH-CHANGED ++ COMPILER::BASE-USED COMPILER::CO1VECTOR-PUSH ++ COMPILER::WT-V*-MACROS COMPILER::CO1CONSTANT-FOLD ++ COMPILER::WT-FIXNUM-VALUE COMPILER::C2BLOCK-CLB ++ SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::SET-JUMP-TRUE ++ COMPILER::C2BIND-LOC COMPILER::IN-ARRAY ++ COMPILER::SET-JUMP-FALSE COMPILER::PROCLAIM-VAR ++ COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::C1CONSTANT-VALUE ++ COMPILER::COMPILER-DEF-HOOK COMPILER::CO1READ-BYTE ++ COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::IS-REFERRED ++ COMPILER::DOTIMES** SYSTEM::ADD-DEBUG COMPILER::DO-REFERRED ++ COMPILER::NEXT-LABEL COMPILER::C2CALL-LAMBDA COMPILER::C2APPLY ++ COMPILER::C1EXPR* COMPILER::C2SETQ COMPILER::MIA ++ COMPILER::C2PSETQ COMPILER::C1SETQ1 ++ COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::WT-NL ++ COMPILER::CO1EQL COMPILER::CFAST-WRITE COMPILER::CO1LDB ++ COMPILER::EQL-NOT-NIL COMPILER::JUMPS-TO-P ++ COMPILER::C2CALL-LOCAL COMPILER::BIGNUM-EXPANSION-STORAGE ++ COMPILER::STACK-LET COMPILER::C2MULTIPLE-VALUE-SETQ ++ COMPILER::C2MEMBER!2 COMPILER::C2UNWIND-PROTECT ++ COMPILER::DOLIST** COMPILER::SET-DBIND COMPILER::DOTIMES* ++ COMPILER::NEXT-CMACRO COMPILER::GET-INLINE-LOC ++ COMPILER::C2STACK-LET)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMPILER::COMPILE-FILE1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -257,9 +268,11 @@ + (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- COMPILER::PUSH-ARRAY)) ++ COMPILER::BSEARCHLEQ)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -267,11 +280,16 @@ + (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- COMPILER::BSEARCHLEQ)) ++ COMPILER::PUSH-ARRAY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*)) ++ COMMON-LISP::T) ++ COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -285,130 +303,121 @@ + COMPILER::DASH-TO-UNDERSCORE-INT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ COMPILER::VS-PUSH COMPILER::WFS-ERROR COMPILER::MACRO-ENV ++ COMPILER::C1T COMPILER::WT-CVARS COMPILER::WT-DATA-END ++ COMPILER::GAZONK-NAME COMPILER::INIT-ENV ++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA COMPILER::CCB-VS-PUSH ++ COMPILER::WT-DATA-FILE COMPILER::WT-FASD-DATA-FILE ++ COMPILER::INC-INLINE-BLOCKS COMPILER::PRINT-CURRENT-FORM ++ COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-DATA-BEGIN ++ COMPILER::BABOON COMPILER::WT-C-PUSH COMPILER::WT-NEXT-VAR-ARG ++ COMPILER::WT-FIRST-VAR-ARG COMPILER::CVS-PUSH ++ COMPILER::TAIL-RECURSION-POSSIBLE COMPILER::RESET-TOP ++ COMPILER::C1NIL COMPILER::PRINT-COMPILER-INFO)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) ++ ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) + COMMON-LISP::T) +- COMPILER::MLIN)) ++ COMPILER::COPY-ARRAY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ COMPILER::T1EXPR COMPILER::WT-TO-STRING COMPILER::C2OR ++ COMPILER::WT-LOC COMPILER::SET-LOC COMPILER::MEXPAND-DEFTYPE ++ COMPILER::C2EXPR COMPILER::C2PROGN COMPILER::C2AND ++ COMPILER::WT-SHORT-FLOAT-LOC COMPILER::WT-CHARACTER-LOC ++ COMPILER::CMP-EVAL COMPILER::T1EVAL-WHEN ++ COMPILER::WT-LONG-FLOAT-LOC COMPILER::CMP-TOPLEVEL-EVAL ++ COMPILER::WT-FIXNUM-LOC)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ COMPILER::FCALLN-INLINE COMPILER::CS-PUSH COMPILER::WT-CLINK ++ COMPILER::COMPILER-COMMAND COMPILER::MAKE-INFO ++ COMPILER::T2PROGN COMPILER::MAKE-TAG COMPILER::C2FSET ++ COMPILER::MAKE-BLK COMPILER::LIST-INLINE ++ COMMON-LISP::COMPILE-FILE COMPILER::MAKE-FUN ++ COMPILER::MAKE-VAR COMPILER::T3PROGN COMPILER::LIST*-INLINE)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(COMMON-LISP::COMPILE COMMON-LISP::DISASSEMBLE COMPILER::CMP-ANON ++ COMPILER::CMP-TMP-MACRO)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::MEMOIZED-HASH-EQUAL)) ++ COMPILER::T3DEFUN-VARARG COMPILER::T3DEFUN-NORMAL ++ COMPILER::C2CALL-GLOBAL COMPILER::C2SWITCH COMPILER::MY-CALL ++ COMPILER::C1MAKE-VAR COMPILER::WT-IF-PROCLAIMED ++ COMPILER::C2STRUCTURE-REF COMPILER::C2CALL-UNKNOWN-GLOBAL ++ COMPILER::WT-GLOBAL-ENTRY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- COMPILER::MACRO-ENV COMPILER::C1T COMPILER::PRINT-CURRENT-FORM +- COMPILER::CCB-VS-PUSH COMPILER::C1NIL +- COMPILER::WT-FASD-DATA-FILE COMPILER::INIT-ENV +- COMPILER::WT-CVARS COMPILER::CVS-PUSH +- COMPILER::WT-FIRST-VAR-ARG COMPILER::WT-NEXT-VAR-ARG +- COMPILER::WT-DATA-FILE COMPILER::WT-C-PUSH +- COMPILER::GAZONK-NAME COMPILER::WT-DATA-END +- COMPILER::INC-INLINE-BLOCKS COMPILER::TAIL-RECURSION-POSSIBLE +- COMPILER::RESET-TOP COMPILER::CLOSE-INLINE-BLOCKS +- COMPILER::PRINT-COMPILER-INFO COMPILER::WFS-ERROR +- COMPILER::VS-PUSH COMPILER::BABOON COMPILER::WT-DATA-BEGIN +- COMPILER::ADD-LOAD-TIME-SHARP-COMMA)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMPILER::T2DEFENTRY COMPILER::T3DEFENTRY COMPILER::DEFSYSFUN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::FIXNUM) +- COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1 +- COMPILER::ANALYZE-REGS)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMPILER::C2PROGV COMPILER::WT-INLINE-COND COMPILER::C2TAGBODY ++ COMPILER::CAN-BE-REPLACED* COMPILER::WT-INLINE-FIXNUM ++ COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-SHORT-FLOAT ++ COMPILER::C2LET* COMPILER::ADD-FAST-LINK ++ COMPILER::C1STRUCTURE-REF1 COMPILER::GET-INLINE-INFO ++ COMPILER::CHECK-FORM-TYPE COMPILER::C2MAPCAN ++ COMPILER::FIX-DOWN-ARGS COMPILER::CMP-EXPAND-MACRO ++ COMPILER::SUBLIS1-INLINE COMPILER::ADD-FUNCTION-PROCLAMATION ++ COMPILER::ADD-FUNCTION-DECLARATION COMPILER::SET-VAR ++ COMPILER::BOOLE3 COMPILER::CJF COMPILER::C2PRINC ++ COMPILER::INLINE-TYPE-MATCHES COMPILER::C1MAP-FUNCTIONS ++ COMPILER::C1DM COMPILER::WT-INLINE-CHARACTER ++ COMPILER::WT-MAKE-CCLOSURE COMPILER::TOO-MANY-ARGS ++ COMPILER::COMPILER-PASS2 COMPILER::WT-INLINE-INTEGER ++ COMPILER::T3DEFCFUN COMPILER::MYSUB ++ COMPILER::WT-INLINE-LONG-FLOAT COMPILER::TOO-FEW-ARGS ++ COMPILER::CHECK-VDECL COMPILER::C2GO COMPILER::C2LET ++ COMPILER::ASSIGN-DOWN-VARS COMPILER::C2CASE ++ COMPILER::C2FUNCALL-SFUN COMPILER::AND-FORM-TYPE ++ COMPILER::C-FUNCTION-NAME COMPILER::C2MAPCAR COMPILER::CJT ++ COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2MAPC)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT COMPILER::CMPERR +- COMPILER::WT-CVAR COMPILER::FAST-LINK-PROCLAIMED-TYPE-P +- COMPILER::C1CASE COMPILER::CMPWARN COMPILER::ADD-INIT +- COMPILER::INIT-NAME COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE +- COMPILER::C1LAMBDA-EXPR)) ++ COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN-LOCAL-ENTRY ++ COMPILER::T3INIT-FUN COMPILER::C2STRUCTURE-SET)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- COMPILER::C2BLOCK COMPILER::C1SYMBOL-FUN +- COMPILER::C2BLOCK-LOCAL COMPILER::C2DECL-BODY +- COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES +- COMPILER::WT-INLINE-LOC COMPILER::C2RETURN-LOCAL +- COMPILER::C1BODY)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::T3DEFUN COMPILER::T2DEFUN COMPILER::T3LOCAL-FUN ++ COMPILER::T3LOCAL-DCFUN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::WT-FIXNUM-VALUE COMPILER::DOLIST** COMPILER::CO1LDB +- COMPILER::PUSH-REFERRED-WITH-START COMPILER::C2ASSOC!2 +- COMPILER::ADD-DEBUG-INFO COMPILER::WT-CHARACTER-VALUE +- COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::C2BIND-LOC +- COMPILER::C2CATCH COMPILER::DO-REFERRED COMPILER::C2BLOCK-CLB +- COMPILER::CO1CONSTANT-FOLD COMPILER::C2CALL-LOCAL +- COMPILER::SHIFT<< COMPILER::C2UNWIND-PROTECT +- COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2DM-BIND-VL +- COMPILER::DOTIMES* COMPILER::REFERRED-LENGTH COMPILER::C1ARGS +- COMPILER::CK-SPEC COMPILER::C2MULTIPLE-VALUE-CALL +- COMPILER::C2CALL-LAMBDA COMPILER::CO1READ-BYTE +- COMPILER::CO1VECTOR-PUSH COMPILER::STACK-LET COMPILER::CMPCK +- COMPILER::MAYBE-EVAL COMPILER::COERCE-LOC COMPILER::C2PSETQ +- SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::WT-MAKE-DCLOSURE +- COMPILER::COMPILER-CC COMPILER::WT-GO COMPILER::C1LAMBDA-FUN +- COMPILER::C2RETURN-CLB COMPILER::C1DECL-BODY +- COMPILER::PUSH-CHANGED-VARS COMPILER::GET-INLINE-LOC +- COMPILER::CO1SUBLIS COMPILER::CHANGED-LENGTH COMPILER::CO1CONS +- COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-JUMP-FALSE +- COMPILER::MAKE-USER-INIT COMPILER::NEXT-CVAR +- COMPILER::CAN-BE-REPLACED COMPILER::WT-V*-MACROS +- COMPILER::NEXT-CMACRO COMPILER::C2RETURN-CCB +- COMPILER::CO1SCHAR COMPILER::IS-CHANGED +- COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::SET-DBIND +- COMPILER::WT-H COMPILER::COERCE-LOC-STRUCTURE-REF +- COMPILER::C1EXPR* COMPILER::IS-REFERRED COMPILER::SHIFT>> +- COMPILER::WT COMPILER::TYPE-AND COMPILER::PRIN1-CMP +- COMPILER::C2BIND-INIT COMPILER::RESULT-TYPE-FROM-ARGS +- COMPILER::EQL-NOT-NIL COMPILER::C2APPLY COMPILER::C2BLOCK-CCB +- COMPILER::WT-NL1 COMPILER::CO1WRITE-CHAR COMPILER::CFAST-WRITE +- COMPILER::NEED-TO-PROTECT COMPILER::T3SHARP-COMMA +- SYSTEM::ADD-DEBUG COMPILER::BIGNUM-EXPANSION-STORAGE +- COMPILER::C2SETQ COMPILER::FLAG-P +- COMPILER::PUSH-CHANGED-WITH-START COMPILER::CMPFIX-ARGS +- COMPILER::CO1STRUCTURE-PREDICATE COMPILER::FAST-READ +- COMPILER::C1CONSTANT-VALUE COMPILER::BASE-USED +- COMPILER::PROCLAIM-VAR COMPILER::CO1TYPEP +- COMPILER::SET-JUMP-TRUE COMPILER::TYPE>= COMPILER::DOTIMES** +- COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::C2MEMBER!2 +- COMPILER::DO-CHANGED COMPILER::ADD-INFO COMPILER::SET-VS +- COMPILER::CHECK-FNAME-ARGS +- COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES +- COMPILER::C2MULTIPLE-VALUE-PROG1 COMPILER::NEXT-LABEL* +- COMPILER::WT-VAR COMPILER::C2THROW COMPILER::INLINE-PROC +- COMPILER::PUSH-REFERRED COMPILER::C2LIST-NTH-IMMEDIATE +- COMPILER::C1FMLA COMPILER::PUSH-CHANGED +- COMPILER::MULTIPLE-VALUE-CHECK COMPILER::MIA +- COMPILER::WT-LABEL COMPILER::WT-NL +- COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::SET-BDS-BIND +- COMPILER::DO-ARRAY COMPILER::WT-REQUIREDS +- COMPILER::C2EXPR-TOP* COMPILER::C2DM-BIND-LOC +- COMPILER::DOLIST* SYSTEM::SWITCH-FINISH +- COMPILER::IS-REP-REFERRED COMPILER::WT-LONG-FLOAT-VALUE +- COMPILER::C1SETQ1 COMPILER::FLAGS COMPILER::CO1EQL +- COMPILER::CHECK-END COMPILER::NEXT-LABEL COMPILER::CK-VL +- COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::C1PROGN* +- COMPILER::C2DM-BIND-INIT COMPILER::STRUCT-TYPE-OPT +- COMPILER::UNWIND-BDS COMPILER::SAFE-COMPILE +- COMPILER::CO1READ-CHAR COMPILER::JUMPS-TO-P SYSTEM::SWITCH +- COMPILER::NEXT-CFUN COMPILER::CO1WRITE-BYTE +- COMPILER::DOWNWARD-FUNCTION COMPILER::COMPILER-DEF-HOOK +- COMPILER::C2STACK-LET COMPILER::C2EXPR-TOP +- COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::IN-ARRAY +- COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY)) ++ COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK ++ COMPILER::INLINE-ARGS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMPILER::COMPILE-FILE1)) +\ No newline at end of file ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::WT-SIMPLE-CALL COMPILER::GET-OUTPUT-PATHNAME)) +\ No newline at end of file +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -255,6 +255,21 @@ struct freelist { + + #define FREE (-1) /* free object */ + ++struct fasd { ++ object stream; /* lisp object of type stream */ ++ object table; /* hash table used in dumping or vector on input*/ ++ object eof; /* lisp object to be returned on coming to eof mark */ ++ object direction; /* holds Cnil or sKinput or sKoutput */ ++ object package; /* the package symbols are in by default */ ++ object index; /* integer. The current_dump index on write */ ++ object filepos; /* nil or the position of the start */ ++ object table_length; /* On read it is set to the size dump array needed ++ or 0 ++ */ ++ object evald_items; /* a list of items which have been eval'd and must ++ not be walked by fasd_patch_sharp */ ++}; ++ + /* + Storage manager for each type. + */ +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -144,7 +144,7 @@ struct key {short n,allow_other_keys; + /* cmpaux.c:185:OF */ extern fixnum object_to_fixnum (object x); /* (x) object x; */ + /* cmpaux.c:263:OF */ extern char *object_to_string (object x); /* (x) object x; */ + typedef int (*FUNC)(); +-/* cmpaux.c:294:OF */ extern void call_init (int init_address, object memory, object fasl_vec, FUNC fptr); /* (init_address, memory, fasl_vec, fptr) int init_address; object memory; object fasl_vec; FUNC fptr; */ ++/* cmpaux.c:294:OF */ extern void call_init (int init_address,object memory,object faslfile); /* (init_address, memory, fasl_vec, fptr) int init_address; object memory; object fasl_vec; FUNC fptr; */ + /* cmpaux.c:339:OF */ extern void do_init (object *statVV); /* (statVV) object *statVV; */ + /* cmpaux.c:416:OF */ extern void gcl_init_or_load1 (void (*fn) (void), const char *file); /* (fn, file) int (*fn)(); char *file; */ + /* conditional.c:200:OF */ extern void gcl_init_conditional (void); /* () */ +--- gcl-2.6.12.orig/o/cmpaux.c ++++ gcl-2.6.12/o/cmpaux.c +@@ -324,63 +324,18 @@ object_to_string(object x) { + /* } */ + /* #endif */ + ++ + void +-call_init(int init_address, object memory, object fasl_vec, FUNC fptr) +-{object form; +- FUNC at; +-/* #ifdef CLEAR_CACHE */ +-/* static int n; */ +-/* static sigset_t ss; */ +- +-/* if (!n) { */ +-/* struct sigaction sa={{(void *)sigh},{{0}},SA_RESTART|SA_SIGINFO,NULL}; */ +- +-/* sigaction(SIGILL,&sa,NULL); */ +-/* sigemptyset(&ss); */ +-/* sigaddset(&ss,SIGILL); */ +-/* sigprocmask(SIG_BLOCK,&ss,NULL); */ +-/* n=1; */ +-/* } */ +-/* #endif */ ++call_init(int init_address,object memory,object faslfile) { + ++ bds_bind(sSPmemory,memory); ++ bds_bind(sSPinit,faslfile); ++ ((FUNC)(memory->cfd.cfd_start+init_address))(); ++ bds_unwind1; ++ bds_unwind1; + +- check_type(fasl_vec,t_vector); +- form=(fasl_vec->v.v_self[fasl_vec->v.v_fillp -1]); ++} + +- if (fptr) at = fptr; +- else +- at=(FUNC)(memory->cfd.cfd_start+ init_address ); +- +-#ifdef VERIFY_INIT +- VERIFY_INIT +-#endif +- +- if (type_of(form)==t_cons && +- form->c.c_car == sSPinit) +- {bds_bind(sSPinit,fasl_vec); +- bds_bind(sSPmemory,memory); +-/* #ifdef CLEAR_CACHE */ +-/* sigprocmask(SIG_UNBLOCK,&ss,NULL); */ +-/* #endif */ +- (*at)(); +-/* #ifdef CLEAR_CACHE */ +-/* sigprocmask(SIG_BLOCK,&ss,NULL); */ +-/* #endif */ +- bds_unwind1; +- bds_unwind1; +- } +- else +- /* old style three arg init, with all init being done by C code. */ +- {memory->cfd.cfd_self = fasl_vec->v.v_self; +- memory->cfd.cfd_fillp = fasl_vec->v.v_fillp; +-/* #ifdef CLEAR_CACHE */ +-/* sigprocmask(SIG_UNBLOCK,&ss,NULL); */ +-/* #endif */ +- (*at)(memory->cfd.cfd_start, memory->cfd.cfd_size, memory); +-/* #ifdef CLEAR_CACHE */ +-/* sigprocmask(SIG_BLOCK,&ss,NULL); */ +-/* #endif */ +-}} + + /* statVV is the address of some static storage, which is used by the + cfunctions to refer to global variables,.. +@@ -393,48 +348,46 @@ call_init(int init_address, object memor + + */ + +-DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0, +- NONE,OO,OO,OO,OO,(void),"") { +- +- sSPmemory->s.s_dbind->cfd.cfd_prof=1; +- +- return Cnil; +- +-} +- + void +-do_init(object *statVV) +-{object fasl_vec=sSPinit->s.s_dbind; +- object data = sSPmemory->s.s_dbind; +- {object *p,*q,y; +- int n=fasl_vec->v.v_fillp -1; +- int i; +- object form; +- check_type(fasl_vec,t_vector); +- form = fasl_vec->v.v_self[n]; +- dcheck_type(form,t_cons); ++do_init(object *statVV) { ++ ++ object faslfile=sSPinit->s.s_dbind; ++ object data=sSPmemory->s.s_dbind; ++ object *p,*q,y; ++ int i,n; ++ object fasl_vec; ++ char ch; ++ ++ ch=readc_stream(faslfile); ++ unreadc_stream(ch,faslfile); ++ ++ if (ch!='\n') { ++ struct fasd * fd; ++ faslfile=FFN(fSopen_fasd)(faslfile,sKinput,OBJNULL,Cnil); ++ fd=(struct fasd *)faslfile->v.v_self; ++ n=fix(fd->table_length); ++ fd->table->v.v_self=alloca(n*sizeof(object)); ++ memset(fd->table->v.v_self,0,n*sizeof(object)); ++ fd->table->v.v_dim=faslfile->v.v_self[1]->v.v_fillp=n; ++ } + ++ n=fix(type_of(faslfile)==t_stream ? read_object(faslfile) : FFN(fSread_fasd_top)(faslfile)); ++ sSPinit->s.s_dbind=fasl_vec=fSmake_vector1_1(n,aet_object,Cnil); + + /* switch SPinit to point to a vector of function addresses */ +- ++ + fasl_vec->v.v_elttype = aet_fix; +- fasl_vec->v.v_dim *= (sizeof(object)/sizeof(fixnum)); +- fasl_vec->v.v_fillp *= (sizeof(object)/sizeof(fixnum)); +- ++ + /* swap the entries */ +- p = fasl_vec->v.v_self; ++ for (i=0,p=fasl_vec->v.v_self,q=statVV;icfd.cfd_self = statVV; +- data->cfd.cfd_fillp= n+1; +- statVV[n] = data; +- ++ data->cfd.cfd_fillp= n; ++ statVV[n-1] = data; + + /* So now the fasl_vec is a fixnum array, containing random addresses of c + functions and other stuff from the compiled code. +@@ -442,16 +395,20 @@ do_init(object *statVV) + */ + /* Now we can run the forms f1 f2 in form= (%init f1 f2 ...) */ + +- form=form->c.c_cdr; +- {object *top=vs_top; +- +- for(i=0 ; i< form->v.v_fillp; i++) +- { +- eval(form->v.v_self[i]); +- vs_top=top; +- } +- } +-}} ++ FFN(fSload_stream)(faslfile,Cnil); ++ if (type_of(faslfile)!=t_stream) ++ FFN(fSclose_fasd)(faslfile); ++ ++} ++ ++DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0, ++ NONE,OO,OO,OO,OO,(void),"") { ++ ++ sSPmemory->s.s_dbind->cfd.cfd_prof=1; ++ ++ return Cnil; ++ ++} + + #ifdef DOS + #define PATH_LIM 8 +@@ -498,14 +455,15 @@ gcl_init_or_load1(void (*fn)(void),const + if (file[strlen(file)-1]=='o') { + + object memory; +- object fasl_data; ++ object faslfile; + file=FIX_PATH_STRING(file); + + memory=new_cfdata(); + memory->cfd.cfd_start= (char *)fn; + printf("Initializing %s\n",file); fflush(stdout); +- fasl_data = read_fasl_data(file); +- call_init(0,memory,fasl_data,0); ++ faslfile=open_stream(make_simple_string(file),smm_input,Cnil,sKerror); ++ SEEK_TO_END_OFILE(faslfile->sm.sm_fp); ++ call_init(0,memory,faslfile); + + } else { + printf("loading %s\n",file); +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -35,22 +35,6 @@ object make_pathname (); + + static int needs_patching; + +- +-struct fasd { +- object stream; /* lisp object of type stream */ +- object table; /* hash table used in dumping or vector on input*/ +- object eof; /* lisp object to be returned on coming to eof mark */ +- object direction; /* holds Cnil or sKinput or sKoutput */ +- object package; /* the package symbols are in by default */ +- object index; /* integer. The current_dump index on write */ +- object filepos; /* nil or the position of the start */ +- object table_length; /* On read it is set to the size dump array needed +- or 0 +- */ +- object evald_items; /* a list of items which have been eval'd and must +- not be walked by fasd_patch_sharp */ +-}; +- + struct fasd current_fasd; + + +@@ -599,7 +583,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd + else + check_type(tabl,t_hashtable);} + massert(str==stream); +- result=alloc_simple_vector(sizeof(struct fasd)/sizeof(int),aet_object); ++ result=alloc_simple_vector(sizeof(struct fasd)/sizeof(object),aet_object); + array_allocself(result,1,Cnil); + {struct fasd *fd= (struct fasd *)result->v.v_self; + fd->table=tabl; +@@ -631,6 +615,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd + fd->index=make_fixnum(dump_index); + fd->filepos=current_fasd.filepos; + fd->package=current_fasd.package; ++ fd->table_length=current_fasd.table_length; + return result; + }} + +@@ -642,7 +627,7 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa + if (type_of(fd->table)==t_vector) + /* input uses a vector */ + {if (fd->table->v.v_self) +- gset(fd->table->v.v_self,0,fix(fd->index),aet_object); ++ fd->table->v.v_dim=0;/*self can be on the stack, and others write there*/ + } + else + if(fd->direction==sKoutput) +@@ -1402,66 +1387,6 @@ clrhash(object table) + table->ht.ht_self[i].hte_value = OBJNULL;} + table->ht.ht_nent =0;} + +- +- +-object read_fasl_vector1(); +-object +-read_fasl_vector(object in) +-{char ch; +- object orig = in; +- object d; +- int tem; +- if (((tem=getc(((FILE *)in->sm.sm_fp))) == EOF) && feof(((FILE *)in->sm.sm_fp))) +- { char *pf; +- coerce_to_filename(in,FN1); +- for (pf=FN1+strlen(FN1);pf>FN1 && pf[-1]!='.';pf--); +- if (pf==FN1) {pf=FN1+strlen(FN1);*pf++='.';} +- snprintf(pf,sizeof(FN1)-(pf-FN1),"data"); +- d=make_simple_string(FN1); +- in = open_stream(d,smm_input,Cnil,Cnil); +- if (in == Cnil) +- FEerror("Can't open file ~s",1,d); +- } +- else if (tem != EOF) +- { ungetc(tem,in->sm.sm_fp);} +- while (1) +- { ch=readc_stream(in); +- if (ch=='#') +- {unreadc_stream(ch,in); +- return read_fasl_vector1(in);} +- if (ch== d_begin_dump){ +- unreadc_stream(ch,in); +- break;}} +- {object ar=FFN(fSopen_fasd)(in,sKinput,0,Cnil); +- int n=fix(current_fasd.table_length); +- object result,last; +- { BEGIN_NO_INTERRUPT; +-#ifdef HAVE_ALLOCA +- current_fasd.table->v.v_self +- = (object *)alloca(n*sizeof(object)); +-#else +- current_fasd.table->v.v_self +- = (object *)alloc_relblock(n*sizeof(object)); +-#endif +- current_fasd.table->v.v_dim=n; +- current_fasd.table->v.v_fillp=n; +- gset( current_fasd.table->v.v_self,0,n,aet_object); +- END_NO_INTERRUPT; +- } +- result=FFN(fSread_fasd_top)(ar); +- if (type_of(result) !=t_vector) goto ERROR; +- last=result->v.v_self[result->v.v_fillp-1]; +- if(type_of(last)!=t_cons || last->c.c_car !=sSPinit) +- goto ERROR; +- current_fasd.table->v.v_self = 0; +- FFN(fSclose_fasd)(ar); +- if (orig != in) +- close_stream(in); +- return result; +- ERROR: FEerror("Bad fasd stream ~a",1,in); +- return Cnil; +-}} +- + object IfaslInStream; + /* static void */ + /* IreadFasdData(void) */ +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -1645,7 +1645,7 @@ DEFUN_NEW("LOAD-STREAM",object,fSload_st + for (;;) { + preserving_whitespace_flag = FALSE; + detect_eos_flag = TRUE; +- x = read_object_non_recursive(strm); ++ x = type_of(strm)==t_stream ? read_object_non_recursive(strm) : FFN(fSread_fasd_top)(strm); + if (x == OBJNULL) + break; + { +@@ -2371,75 +2371,3 @@ gcl_init_file_function() + gcl_init_readline_function(); + #endif + } +- +- +-object +-read_fasl_data(const char *str) { +- +- object faslfile, data; +-#ifndef SEEK_TO_END_OFILE +-#if defined(BSD) && defined(UNIX) +- FILE *fp; +- int i; +-#ifdef HAVE_AOUT +- struct exec header; +-#endif +-#endif +-#ifdef HAVE_FILEHDR +- struct filehdr fileheader; +-#endif +-#ifdef E15 +- struct exec header; +-#endif +-#endif +- vs_mark; +- +- faslfile = make_simple_string(str); +- vs_push(faslfile); +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); +- vs_push(faslfile); +- +-#ifdef SEEK_TO_END_OFILE +- SEEK_TO_END_OFILE(faslfile->sm.sm_fp); +-#else +- +-#ifdef BSD +- fp = faslfile->sm.sm_fp; +- fread(&header, sizeof(header), 1, fp); +- fseek(fp, +- header.a_text+header.a_data+ +- header.a_syms+header.a_trsize+header.a_drsize, +- 1); +- fread(&i, sizeof(i), 1, fp); +- fseek(fp, i - sizeof(i), 1); +-#endif +- +-#ifdef HAVE_FILEHDR +- fp = faslfile->sm.sm_fp; +- fread(&fileheader, sizeof(fileheader), 1, fp); +- fseek(fp, +- fileheader.f_symptr+fileheader.f_nsyms*SYMESZ, +- 0); +- fread(&i, sizeof(i), 1, fp); +- fseek(fp, i - sizeof(i), 1); +- while ((i = getc(fp)) == 0) +- ; +- ungetc(i, fp); +-#endif +- +-#ifdef E15 +- fp = faslfile->sm.sm_fp; +- fread(&header, sizeof(header), 1, fp); +- fseek(fp, +- header.a_text+header.a_data+ +- header.a_syms+header.a_trsize+header.a_drsize, +- 1); +-#endif +-#endif +- data = read_fasl_vector(faslfile); +- +- vs_push(data); +- close_stream(faslfile); +- vs_reset; +- return(data); +-} +--- gcl-2.6.12.orig/o/gprof.c ++++ gcl-2.6.12/o/gprof.c +@@ -5,6 +5,10 @@ + + static unsigned long gprof_on; + ++#ifdef DARWIN ++void _mcleanup() {} ++#endif ++ + DEFUN_NEW("MCLEANUP",object,fSmcleanup,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + + extern void _mcleanup(void); +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -333,16 +333,16 @@ setup_READ() + backq_level = 0; + } + +-static void +-setup_standard_READ() +-{ +- READtable = standard_readtable; +- READdefault_float_format = 'F'; +- READbase = 10; +- READsuppress = FALSE; +- sSAsharp_eq_contextA->s.s_dbind=Cnil; +- backq_level = 0; +-} ++/* static void */ ++/* setup_standard_READ() */ ++/* { */ ++/* READtable = standard_readtable; */ ++/* READdefault_float_format = 'F'; */ ++/* READbase = 10; */ ++/* READsuppress = FALSE; */ ++/* sSAsharp_eq_contextA->s.s_dbind=Cnil; */ ++/* backq_level = 0; */ ++/* } */ + + object + read_char(in) +@@ -1393,28 +1393,6 @@ FFN(siLsharp_comma_reader_for_compiler)( + vs_base[0] = make_cons(siSsharp_comma, vs_base[0]); + } + +-/* +- For fasload. +-*/ +-static void +-Lsharp_exclamation_reader() +-{ +- check_arg(3); +- if(vs_base[2] != Cnil && !READsuppress) +- extra_argument('!'); +- vs_popp; +- vs_popp; +- if (READsuppress) { +- vs_base[0] = Cnil; +- return; +- } +- vs_base[0] = read_object(vs_base[0]); +- if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) +- vs_base[0]=patch_sharp(vs_base[0]); +- ieval(vs_base[0]); +- vs_popp; +-} +- + static void + Lsharp_B_reader() + { +@@ -2327,8 +2305,6 @@ gcl_init_read() + dtab['*'] = make_cf(Lsharp_asterisk_reader); + dtab[':'] = make_cf(Lsharp_colon_reader); + dtab['.'] = make_cf(Lsharp_dot_reader); +- dtab['!'] = make_cf(Lsharp_exclamation_reader); +- /* Used for fasload only. */ + dtab[','] = make_cf(Lsharp_comma_reader); + dtab['B'] = dtab['b'] = make_cf(Lsharp_B_reader); + dtab['O'] = dtab['o'] = make_cf(Lsharp_O_reader); +@@ -2441,96 +2417,96 @@ gcl_init_read_function() + + object sSPinit; + +-object +-read_fasl_vector1(in) +-object in; +-{ +- int dimcount, dim; +- VOL object *vsp; +- object vspo; +- VOL object x; +- long i; +- bool e; +- object old_READtable; +- int old_READdefault_float_format; +- int old_READbase; +- int old_READsuppress; +- volatile object old_READcontext; +- int old_backq_level; +- +- /* to prevent longjmp clobber */ +- i=(long)&vsp; +- i+=i; +- vsp=&vspo; +- old_READtable = READtable; +- old_READdefault_float_format = READdefault_float_format; +- old_READbase = READbase; +- old_READsuppress = READsuppress; +- old_READcontext=sSAsharp_eq_contextA->s.s_dbind; +- /* BUG FIX by Toshiba */ +- vs_push(old_READtable); +- old_backq_level = backq_level; +- +- setup_standard_READ(); +- +- frs_push(FRS_PROTECT, Cnil); +- if (nlj_active) { +- e = TRUE; +- goto L; +- } +- +- while (readc_stream(in) != '#') +- ; +- while (readc_stream(in) != '(') +- ; +- vsp = vs_top; +- dimcount = 0; +- for (;;) { +- sSAsharp_eq_contextA->s.s_dbind=Cnil; +- backq_level = 0; +- delimiting_char = code_char(')'); +- preserving_whitespace_flag = FALSE; +- detect_eos_flag = FALSE; +- x = read_object(in); +- if (x == OBJNULL) +- break; +- vs_check_push(x); +- if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) +- x = vs_head = patch_sharp(x); +- dimcount++; +- } +- if(dimcount==1 && type_of(vs_head)==t_vector) +- {/* new style where all read at once */ +- x=vs_head; +- goto DONE;} +- /* old style separately sharped, and no %init */ +- {BEGIN_NO_INTERRUPT; +- x=alloc_simple_vector(dimcount,aet_object); +- vs_push(x); +- x->v.v_self +- = (object *)alloc_relblock(dimcount * sizeof(object)); +- END_NO_INTERRUPT;} +- for (dim = 0; dim < dimcount; dim++) +- {SGC_TOUCH(x); +- x->cfd.cfd_self[dim] = vsp[dim];} ++/* object */ ++/* read_fasl_vector1(in) */ ++/* object in; */ ++/* { */ ++/* int dimcount, dim; */ ++/* VOL object *vsp; */ ++/* object vspo; */ ++/* VOL object x; */ ++/* long i; */ ++/* bool e; */ ++/* object old_READtable; */ ++/* int old_READdefault_float_format; */ ++/* int old_READbase; */ ++/* int old_READsuppress; */ ++/* volatile object old_READcontext; */ ++/* int old_backq_level; */ ++ ++/* /\* to prevent longjmp clobber *\/ */ ++/* i=(long)&vsp; */ ++/* i+=i; */ ++/* vsp=&vspo; */ ++/* old_READtable = READtable; */ ++/* old_READdefault_float_format = READdefault_float_format; */ ++/* old_READbase = READbase; */ ++/* old_READsuppress = READsuppress; */ ++/* old_READcontext=sSAsharp_eq_contextA->s.s_dbind; */ ++/* /\* BUG FIX by Toshiba *\/ */ ++/* vs_push(old_READtable); */ ++/* old_backq_level = backq_level; */ ++ ++/* setup_standard_READ(); */ ++ ++/* frs_push(FRS_PROTECT, Cnil); */ ++/* if (nlj_active) { */ ++/* e = TRUE; */ ++/* goto L; */ ++/* } */ ++ ++/* while (readc_stream(in) != '#') */ ++/* ; */ ++/* while (readc_stream(in) != '(') */ ++/* ; */ ++/* vsp = vs_top; */ ++/* dimcount = 0; */ ++/* for (;;) { */ ++/* sSAsharp_eq_contextA->s.s_dbind=Cnil; */ ++/* backq_level = 0; */ ++/* delimiting_char = code_char(')'); */ ++/* preserving_whitespace_flag = FALSE; */ ++/* detect_eos_flag = FALSE; */ ++/* x = read_object(in); */ ++/* if (x == OBJNULL) */ ++/* break; */ ++/* vs_check_push(x); */ ++/* if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) */ ++/* x = vs_head = patch_sharp(x); */ ++/* dimcount++; */ ++/* } */ ++/* if(dimcount==1 && type_of(vs_head)==t_vector) */ ++/* {/\* new style where all read at once *\/ */ ++/* x=vs_head; */ ++/* goto DONE;} */ ++/* /\* old style separately sharped, and no %init *\/ */ ++/* {BEGIN_NO_INTERRUPT; */ ++/* x=alloc_simple_vector(dimcount,aet_object); */ ++/* vs_push(x); */ ++/* x->v.v_self */ ++/* = (object *)alloc_relblock(dimcount * sizeof(object)); */ ++/* END_NO_INTERRUPT;} */ ++/* for (dim = 0; dim < dimcount; dim++) */ ++/* {SGC_TOUCH(x); */ ++/* x->cfd.cfd_self[dim] = vsp[dim];} */ + + +- DONE: +- e = FALSE; ++/* DONE: */ ++/* e = FALSE; */ + +-L: +- frs_pop(); ++/* L: */ ++/* frs_pop(); */ + +- READtable = old_READtable; +- READdefault_float_format = old_READdefault_float_format; +- READbase = old_READbase; +- READsuppress = old_READsuppress; +- sSAsharp_eq_contextA->s.s_dbind=old_READcontext; +- backq_level = old_backq_level; +- if (e) { +- nlj_active = FALSE; +- unwind(nlj_fr, nlj_tag); +- } +- vs_top = (object *)vsp; +- return(x); +-} ++/* READtable = old_READtable; */ ++/* READdefault_float_format = old_READdefault_float_format; */ ++/* READbase = old_READbase; */ ++/* READsuppress = old_READsuppress; */ ++/* sSAsharp_eq_contextA->s.s_dbind=old_READcontext; */ ++/* backq_level = old_backq_level; */ ++/* if (e) { */ ++/* nlj_active = FALSE; */ ++/* unwind(nlj_fr, nlj_tag); */ ++/* } */ ++/* vs_top = (object *)vsp; */ ++/* return(x); */ ++/* } */ +--- gcl-2.6.12.orig/o/sfasl.c ++++ gcl-2.6.12/o/sfasl.c +@@ -80,619 +80,5 @@ DEFUN_NEW("FIND-SYM-PTABLE",object,fSfin + #ifdef SEPARATE_SFASL_FILE + #include SEPARATE_SFASL_FILE + #else +- +-#include "ext_sym.h" +-struct node * find_sym(); +-int node_compare(); +-#ifndef _WIN32 +-void *malloc(); +-void *bsearch(); +-#endif +- +-struct reloc relocation_info; +-/* next 5 static after debug */ +- +-int debug; +- +-#ifdef DEBUG +-#define debug sfasldebug +-int sfasldebug=0; +-#define dprintf(s,ar) if(debug) { printf(" ( s )",ar) ; fflush(stdout);} +-#define STAT +- +-#else /* end debug */ +-#define dprintf(s,ar) +-#define STAT static +-#endif +- +-#ifndef MAXPATHLEN +-#define MAXPATHLEN 256 +-#endif +-#define PTABLE_EXTRA 20 +- +-struct sfasl_info { +- struct syment *s_symbol_table; +- char *s_start_address; +- char *s_start_data; +- char *s_start_bss; +- char *s_my_string_table; +- int s_extra_bss; +- char *s_the_start; +- +-}; +-struct sfasl_info *sfaslp; +- +-#define symbol_table sfaslp->s_symbol_table +-#define start_address sfaslp->s_start_address +-#define my_string_table sfaslp->s_my_string_table +-#define extra_bss sfaslp->s_extra_bss +-#define the_start sfaslp->s_the_start +- +- +-#ifndef describe_sym +-#define describe_sym(a) +-#endif +- +-#ifdef STAND +-#include "rel_stand.c" +-#endif +- +-/* begin reloc_file */ +-#include RELOC_FILE +- +-/* end reloc_file */ +-int get_extra_bss ( struct syment *sym_table, int length, int start, int *ptr, int bsssize); +-void relocate_symbols ( unsigned int length ); +-void set_symbol_address ( struct syment *sym, char *string ); +- +-int +-fasload(faslfile) +-object faslfile; +-{ long fasl_vector_start; +- struct filehdr fileheader; +- struct sfasl_info sfasl_info_buf; +-#ifdef COFF +- struct scnhdr section[10]; +- struct aouthdr header; +-#endif +- int textsize, datasize, bsssize,nsyms; +-#if defined ( READ_IN_STRING_TABLE ) || defined ( HPUX ) +- int string_size=0; +-#endif +- +- object memory, data; +- FILE *fp; +- char filename[MAXPATHLEN]; +- int i; +- int init_address=0; +-#ifndef STAND +- object *old_vs_base = vs_base; +- object *old_vs_top = vs_top; +-#endif +- sfaslp = &sfasl_info_buf; +- +- extra_bss=0; +-#ifdef STAND +- strcpy(filename,faslfile); +- fp=fopen(filename,"r"); +-#else +- coerce_to_filename(faslfile, filename); +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); +- vs_push(faslfile); +- fp = faslfile->sm.sm_fp; +-#endif +- +- HEADER_SEEK(fp); +- if(!fread((char *)&fileheader, sizeof(struct filehdr), 1, fp)) +- FEerror("Could not get the header",0,0); +- nsyms = NSYMS(fileheader); +-#ifdef COFF +- +-#ifdef AIX3 +- setup_for_aix_load(); +-#endif +- +- fread(&header,1,fileheader.f_opthdr,fp); +- +- fread(§ion[1],fileheader.f_nscns,sizeof (struct scnhdr),fp); +- textsize = section[TEXT_NSCN].s_size; +- datasize = section[DATA_NSCN].s_size; +- if (strcmp(section[BSS_NSCN].s_name, ".bss") == 0) +- bsssize=section[BSS_NSCN].s_size; +- else bsssize=section[BSS_NSCN].s_size = 0; +-#endif +- +-#ifdef BSD +- textsize=fileheader.a_text; +- datasize=fileheader.a_data; +- bsssize=fileheader.a_bss; +-#endif +- symbol_table = +- (struct syment *) OUR_ALLOCA(sizeof(struct syment)* +- (unsigned int)nsyms); +- fseek(fp,(int)( N_SYMOFF(fileheader)), 0); +- { +- for (i = 0; i < nsyms; i++) +- { fread((char *)&symbol_table[i], SYMESZ, 1, fp); +- dprintf( symbol table %d , i); +- if (debug) describe_sym(i); +- dprintf( at %d , &symbol_table[i]); +-#ifdef HPUX +- symbol_table[i].n_un.n_strx = string_size; +- dprintf(string_size %d, string_size); +- string_size += symbol_table[i].n_length + 1; +- fseek(fp,(int)symbol_table[i].n_length,1); +-#endif +- } +- } +-/* +-on MP386 +-The sizeof(struct syment) = 20, while only SYMESZ =18. So we had to read +-one at a time. +-fread((char *)symbol_table, SYMESZ*fileheader.f_nsyms,1,fp); +-*/ +- +-#ifdef READ_IN_STRING_TABLE +- +-my_string_table=READ_IN_STRING_TABLE(fp,string_size); +- +-#else +-#ifdef MUST_SEEK_TO_STROFF +- fseek(fp,N_STROFF(fileheader),0); +-#endif +- {int ii=0; +- if (!fread((char *)&ii,sizeof(int),1,fp)) +- {FEerror("The string table of this file did not have any length",0, +- 0);} +- fseek(fp,-4,1); +- /* at present the string table is located just after the symbols */ +- my_string_table=OUR_ALLOCA((unsigned int)ii); +- dprintf( string table leng = %d, ii); +- +- if(ii!=fread(my_string_table,1,ii,fp)) +- FEerror("Could not read whole string table",0,0) ; +- } +-#endif +-#ifdef SEEK_TO_END_OFILE +-SEEK_TO_END_OFILE(fp); +-#else +- while ((i = getc(fp)) == 0) +- ; +- ungetc(i, fp); +-#endif +- +- fasl_vector_start=ftell(fp); +- +- if (!((c_table.ptable) && *(c_table.ptable))) +- build_symbol_table(); +- +-/* figure out if there is more bss space needed */ +- extra_bss=get_extra_bss(symbol_table,nsyms,datasize+textsize+bsssize, +- &init_address,bsssize); +- +-/* allocate some memory */ +-#ifndef STAND +- {BEGIN_NO_INTERRUPT; +- memory=new_cfdata(); +- memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss; +- vs_push(memory); +- the_start=start_address= +- memory->cfd.cfd_start= +- alloc_contblock(memory->cfd.cfd_size); +- sfaslp->s_start_data = start_address + textsize; +- sfaslp->s_start_bss = start_address + textsize + datasize; +- END_NO_INTERRUPT; +- } +-#else +- the_start = start_address +- = malloc ( datasize + textsize + bsssize + extra_bss ); +- sfaslp->s_start_data = start_address + textsize; +- sfaslp->s_start_bss = start_address + textsize + datasize; +-#endif +- +- dprintf( code size %d , datasize+textsize+bsssize + extra_bss); +- if (fseek(fp,N_TXTOFF(fileheader) ,0) < 0) +- FEerror("file seek error",0,0); +- SAFE_FREAD(the_start, textsize + datasize, 1, fp); +- dprintf(read into memory text +data %d bytes, textsize + datasize); +-/* relocate the actual loaded text */ +- +- dprintf( the_start %x, the_start); +- +- /* record which symbols are used */ +- +-#ifdef SYM_USED +- {int j=0; +- for(j=1; j< BSS_NSCN ; j++) +- { dprintf( relocating section %d \n,j); +- if (section[j].s_nreloc) fseek(fp,section[j].s_relptr,0); +- for(i=0; i < section[j].s_nreloc; i++) +- { struct syment *sym; +- fread(&relocation_info, RELSZ, 1, fp); +- sym = & symbol_table[relocation_info.r_symndx]; +- if (TC_SYMBOL_P(sym)) +- SYM_USED(sym) = 1; +- }}} +-#endif +- +- +- /* this looks up symbols in c.ptable and also adds new externals to +- that c.table */ +- relocate_symbols(NSYMS(fileheader)); +- +-#ifdef COFF +- {int j=0; +- for(j=1; j< BSS_NSCN ; j++) +- { dprintf( relocating section %d \n,j); +- if (section[j].s_nreloc) fseek(fp,section[j].s_relptr,0); +-#ifdef ADJUST_RELOC_START +-ADJUST_RELOC_START(j) +-#endif +- for(i=0; i < section[j].s_nreloc; i++) +- /* RELSZ = sizeof(relocation_info) */ +- {fread(&relocation_info, RELSZ, 1, fp); +- dprintf(relocating %d,i); +- relocate();}; +- }}; +-#endif +-#ifdef BSD +- fseek(fp,N_RELOFF(fileheader),0); +- {int nrel = (fileheader.a_trsize/sizeof(struct reloc)); +- for (i=0; i < nrel; i++) +- {fread((char *)&relocation_info, sizeof(struct reloc), +- 1, fp); +- dprintf(relocating %d,i); +- relocate(); +- } +- } +-#ifdef N_DRELOFF +- fseek (fp, N_DRELOFF(fileheader), 0); +-#endif +- {int nrel = (fileheader.a_drsize/sizeof(struct reloc)); +- the_start += fileheader.a_text; +- for (i=0; i < nrel; i++) +- +- {fread((char *)&relocation_info, sizeof(struct reloc), +- 1, fp); +- dprintf(relocating %d,i); +- relocate(); +- } +- } +-#endif +- +-/* end of relocation */ +- dprintf( END OF RELOCATION \n,0); +- dprintf( invoking init function at %x, start_address) +- dprintf( textsize is %x,textsize); +- dprintf( datasize is %x,datasize); +- +-/* read in the fasl vector */ +- fseek(fp,fasl_vector_start,0); +- if (feof(fp)) +- {data=0;} +- else{ +- data = read_fasl_vector(faslfile); +- vs_push(data); +-#ifdef COFF +- dprintf( read fasl now symbols %d , fileheader.f_nsyms); +-#endif +- } +- close_stream(faslfile); +- +-/* +- { +- int fd; +- +- fd = creat ("xsgcl.bits", 0777); +- write (fd, memory->cfd.cfd_start, textsize + datasize); +- close (fd); +- +- fd = open ("xsl2.bits", 0); +- read (fd, memory->cfd.cfd_start, memory->cfd.cfd_size); +- close (fd); +- } +-*/ +- +-#ifndef STAND +- ALLOCA_FREE(my_string_table); +- ALLOCA_FREE(symbol_table); +- +- +-#ifdef CLEAR_CACHE +- CLEAR_CACHE; +-#endif +- call_init(init_address,memory,data,0); +- +- vs_base = old_vs_base; +- vs_top = old_vs_top; +- if(symbol_value(sLAload_verboseA)!=Cnil) +- printf("start address -T %x ", memory->cfd.cfd_start); +- return(memory->cfd.cfd_size); +-#endif +- {FILE *out; +- out=fopen("/tmp/sfasltest","w"); +- fwrite((char *)&fileheader, sizeof(struct filehdr), 1, out); +- fwrite(start_address,sizeof(char),datasize+textsize,out); +- fclose(out);} +- printf("\n(start %x)\n",start_address); +- +-} +- +-int get_extra_bss(sym_table,length,start,ptr,bsssize) +- int length,bsssize; +- struct syment *sym_table; +- int *ptr; /* store init address offset here */ +-{ +- int result = start; +- +-#ifdef AIX3 +- int next_bss = start - bsssize; +-#endif +- +- struct syment *end,*sym; +- +-#ifdef BSD +- char tem[SYMNMLEN +1]; +-#endif +- +- end =sym_table + length; +- for(sym=sym_table; sym < end; sym++) +- { +- +-#ifdef FIND_INIT +- FIND_INIT +-#endif +- +-#ifdef AIX3 +- /* we later go through the relocation entries making this 1 +- for symbols used */ +-#ifdef SYM_USED +- if(TC_SYMBOL_P(sym)) +- {SYM_USED(sym) = 0;} +-#endif +- +- /* fix up the external refer to _ptrgl to be local ref */ +- if (sym->n_scnum == 0 && +- strcmp(sym->n_name,"_ptrgl")==0) +- {struct syment* s = +- get_symbol("._ptrgl",TEXT_NSCN,sym_table,length); +- if (s ==0) FEerror("bad glue",0,0); +- sym->n_value = next_bss ; +- ptrgl_offset = next_bss; +- ptrgl_text = s->n_value; +- next_bss += 0xc; +- sym->n_scnum = DATA_NSCN; +- ((union auxent *)(sym+1))->x_csect.x_scnlen = 0xc; +- +- } +- +- if(sym->n_scnum != BSS_NSCN) goto NEXT; +- if(SYM_EXTERNAL_P(sym)) +- {int val=sym->n_value; +- struct node joe; +- if (val && c_table.ptable) +- {struct node *answ; +- answ= find_sym(sym,0); +- if(answ) +- {sym->n_value = answ->address ; +- sym->n_scnum = N_UNDEF; +- val= ((union auxent *)(sym+1))->x_csect.x_scnlen; +- result -= val; +- goto NEXT; +- }} +- } +- /* reallocate the bss space */ +- if (sym->n_value == 0) +- {result += ((union auxent *)(sym+1))->x_csect.x_scnlen;} +- sym->n_value = next_bss; +- next_bss += ((union auxent *)(sym+1))->x_csect.x_scnlen; +- NEXT: +- ; +- /* end aix3 */ +-#endif +- +- +- +-#ifdef BSD +- tem; /* ignored */ +- if(SYM_EXTERNAL_P(sym) && SYM_UNDEF_P(sym)) +-#endif +-#ifdef COFF +- if(0) +- /* what we really want is +- if (sym->n_scnum==0 && sym->n_sclass == C_EXT +- && !(bsearch(..in ptable for this symbol))) +- Since this won't allow loading in of a new external array +- char foo[10] not ok +- static foo[10] ok. +- for the moment we give undefined symbol warning.. +- Should really go through the symbols, recording the external addr +- for ones found in ptable, and for the ones not in ptable +- set some flag, and add up the extra_bss required. Then +- when you have the new memory chunk in hand, +- you could make the pass setting the relative addresses. +- for the ones you flagged last time. +- */ +-#endif +- /* external bss so not included in size of bss for file */ +- {int val=sym->n_value; +- if (val && c_table.ptable +- && (0== find_sym(sym,0))) +- { sym->n_value=result; +- result += val;}} +- +- sym += NUM_AUX(sym); +- +- } +- return (result-start); +-} +- +- +- +-/* go through the symbol table changing the addresses of the symbols +-to reflect the current cfd_start */ +- +- +-void +-relocate_symbols(length) +-unsigned int length; +-{struct syment *end,*sym; +- unsigned int typ; +- char *str; +- char tem[SYMNMLEN +1]; +- tem[SYMNMLEN]=0; +- int n_value=(int)start_address; +- +- end =symbol_table + length; +- for(sym=symbol_table; sym < end; sym++) { +- typ=NTYPE(sym); +-#ifdef BSD +-#ifdef N_STAB +- if (N_STAB & sym->n_type) continue;/* skip: It is for dbx only */ +-#endif +- typ=N_SECTION(sym); +-/* if(sym->n_type & N_EXT) should add the symbol name, +- so it would be accessible by future loads */ +-#endif +- switch (typ) { +-#ifdef BSD +- case N_ABS : case N_TEXT: case N_DATA: case N_BSS: +-#endif +-#ifdef COFF +- case TEXT_NSCN : case DATA_NSCN: case BSS_NSCN : +-#ifdef _WIN32 +- if (typ==DATA_NSCN) +- n_value = (int)sfaslp->s_start_data; +- if (typ==BSS_NSCN) +- n_value = (int)sfaslp->s_start_bss; +- if (typ==TEXT_NSCN) +- n_value = (int)start_address; +-#endif /* _WIN32 */ +-#endif /* COFF */ +- str=SYM_NAME(sym); +- dprintf( for sym %s ,str) +- dprintf( new value will be start %x, start_address); +- +-#ifdef AIX3 +- if(N_SECTION(sym) == DATA_NSCN +- && NUM_AUX(sym) +- && allocate_toc(sym)) +- break; +-#endif +- sym->n_value = n_value; +- break; +- case N_UNDEF: +- str=SYM_NAME(sym); +- dprintf( undef symbol %s ,str); +- dprintf( symbol diff %d , sym - symbol_table); +- describe_sym(sym-symbol_table); +- set_symbol_address(sym,str); +- describe_sym(sym-symbol_table); +- break; +- default: +-#ifdef COFF +- dprintf(am ignoring a scnum %d,(sym->n_scnum)); +-#endif +- break; +- } +- sym += NUM_AUX(sym); +- } +-} +- +-/* +-STEPS: +-1) read in the symbol table from the file, +-2) go through the symbol table, relocating external entries. +-3) for i <=2 go thru the relocation information for this section +- relocating the text. +-4) done. +-*/ +- +-struct node * +-find_sym(sym,name) +- struct syment *sym; +- char *name; +-{ char tem[SYMNMLEN +1]; +- tem [SYMNMLEN] = 0; +- if (name==0) name = SYM_NAME(sym); +- return find_sym_ptable(name);} +- +-void +-set_symbol_address(sym,string) +-struct syment *sym; +-char *string; +-{struct node *answ; +- if (c_table.ptable) +- { +- dprintf(string %s, string); +- answ = find_sym(sym,string); +- dprintf(answ %d , (answ ? answ->address : -1)); +- if(answ) +- { +-#ifdef COFF +-#ifdef _AIX370 +- if (NTYPE(sym) == N_UNDEF) +- sym->n_value = answ->address; +- else +-#endif +- sym->n_value = answ->address -sym->n_value; +- /* for symbols in the local data,text and bss this gets added +- on when we add the current value */ +-#endif +-#ifdef BSD +- /* the old value of sym->n_value is the length of the common area +- starting at this address */ +- sym->n_value = answ->address; +-#endif +-#ifdef AIX3 +- fix_undef_toc_address(answ,sym,string); +-#endif +- +-} +- else +- { +-/* +-#ifdef BSD +- {char *name; +- name=malloc(1+strlen(string)); +- strcpy(name,string); +- sym->n_value = sym->n_value + (unsigned int) the_start; +- add_symbol(name,sym->n_value,NULL); +- } +-#endif +-*/ +- fprintf(stdout,"undefined %s symbol",string) +- ;fflush(stdout); +- +- }} +- +- else{FEerror("symbol table not loaded",0,0);}} +- +-/* include the machine independent stuff */ +-#include "sfasli.c" +- +- +-#ifdef DEBUG +-print_name(p) +- struct syment *p; +-{char tem[10],*name; +- name=SYM_NAME(p); +- name= (((p)->_n._n_n._n_zeroes == 0) ? +- &my_string_table[(p)->_n._n_n._n_offset] : +- ((p)->_n._n_name[SYMNMLEN -1] ? +- (strncpy(tem,(p)->_n._n_name, +- SYMNMLEN), +- (char *)tem) : +- (p)->_n._n_name )); +- +- printf("(name:|%s|)",name); +- printf("(sclass 0x%x)",p->n_sclass); +- printf("(external_p 0x%x)",SYM_EXTERNAL_P(p)); +- printf("(n_type 0x%x)",p->n_type); +- printf("(n_value 0x%x)",p->n_value); +- printf("(numaux 0x%x)\n",NUM_AUX(p)); +- fflush(stdout); +-} +-#endif +- ++#error must define SEPARATE_SFASL_FILE + #endif /* SEPARATE_SFASL_FILE */ +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -443,7 +443,6 @@ fasload(object faslfile) { + fseek(fp,(void *)ste-st,0); + while ((i = getc(fp)) == 0); + ungetc(i, fp); +- data = read_fasl_vector(faslfile); + + massert(!un_mmap(st,est)); + +@@ -451,7 +450,7 @@ fasload(object faslfile) { + CLEAR_CACHE; + #endif + +- call_init(init_address,memory,data,0); ++ call_init(init_address,memory,faslfile); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %p ", memory->cfd.cfd_start); +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -550,7 +550,7 @@ fasload(object faslfile) { + FILE *fp; + char *sn,*st1,*dst1; + ul init_address=0,end,gs=0,*got=&gs,*gote=got+1; +- object memory,data; ++ object memory; + Shdr *sec1,*sece; + Sym *sym1,*syme,*dsym1,*dsyme; + void *v1,*ve; +@@ -574,7 +574,6 @@ fasload(object faslfile) { + massert(!relocate_code(v1,sec1,sece,sym1,got,gote)); + + massert(!fseek(fp,end,SEEK_SET)); +- data=feof(fp) ? 0 : read_fasl_vector(faslfile); + + massert(!un_mmap(v1,ve)); + +@@ -587,7 +586,7 @@ fasload(object faslfile) { + #endif + + init_address-=(ul)memory->cfd.cfd_start; +- call_init(init_address,memory,data,0); ++ call_init(init_address,memory,faslfile); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %p ",memory->cfd.cfd_start); +--- gcl-2.6.12.orig/o/sfaslmacho.c ++++ gcl-2.6.12/o/sfaslmacho.c +@@ -421,7 +421,7 @@ load_self_symbols() { + + for (a=c_table.ptable,sym=sym1;symn_type & N_STAB || !(sym->n_type & N_EXT)) ++ if ((sym->n_type & N_STAB) || !(sym->n_type & N_EXT)) + continue; + + a->address=sym->n_value; +@@ -435,10 +435,9 @@ load_self_symbols() { + c_table.length=a-c_table.ptable; + qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); + +- c_table.local_ptable=a; +- for (a=c_table.ptable,sym=sym1;symn_type & N_STAB || sym->n_type & N_EXT) ++ if ((sym->n_type & N_STAB) || sym->n_type & N_EXT) + continue; + + a->address=sym->n_value; +@@ -536,7 +535,6 @@ int + fasload(object faslfile) { + + FILE *fp; +- object data; + ul init_address=-1; + object memory; + void *v1,*ve,*p; +@@ -564,7 +562,6 @@ fasload(object faslfile) { + relocate_code(v1,sec1,sece,&p,io1,n1,got,gote,start); + + fseek(fp,(void *)ste-v1,SEEK_SET); +- data = feof(fp) ? 0 : read_fasl_vector(faslfile); + + massert(!clear_protect_memory(memory)); + +@@ -575,7 +572,7 @@ fasload(object faslfile) { + massert(!un_mmap(v1,ve)); + + init_address-=(ul)memory->cfd.cfd_start; +- call_init(init_address,memory,data,0); ++ call_init(init_address,memory,faslfile); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf("start address -T %p ",memory->cfd.cfd_start); +--- gcl-2.6.12.orig/o/sfaslmacosx.c ++++ gcl-2.6.12/o/sfaslmacosx.c +@@ -228,8 +228,6 @@ int fasload (object faslfile) + sfasl_error ("error seeking to end of object file"); + } + +- data = read_fasl_vector (faslstream); +- + close_stream (faslstream); + + memory=new_cfdata(); +@@ -237,7 +235,7 @@ int fasload (object faslfile) + if (symbol_value (sLAload_verboseA) != Cnil) + printf (" start address (dynamic) %p ", fptr); + +- call_init (0, memory, data, fptr); ++ call_init (0,memory,faslstream); + + unlink (tmpfile); + +--- gcl-2.6.12.orig/o/unixfasl.c ++++ gcl-2.6.12/o/unixfasl.c +@@ -78,197 +78,7 @@ Foundation, 675 Mass Ave, Cambridge, MA + #endif + + #ifndef SFASL +-int +-fasload(faslfile) +-object faslfile; +-{ +- +-#ifdef BSD +- struct exec header, newheader; +-#endif +- +-#ifdef ATT +- struct filehdr fileheader; +- struct scnhdr sectionheader; +- int textsize, datasize, bsssize; +- int textstart; +-#endif +- +-#ifdef E15 +- struct exec header; +-#define textsize header.a_text +-#define datasize header.a_data +-#define bsssize header.a_bss +-#define textstart sizeof(header) +-#endif +- +- object memory, data, tempfile; +- FILE *fp; +- char filename[MAXPATHLEN]; +- char tempfilename[32]; +- char command[MAXPATHLEN * 2]; +- int i; +- object *old_vs_base = vs_base; +- object *old_vs_top = vs_top; +-#ifdef IBMRT +- +-#endif +- +- coerce_to_filename(faslfile, filename); +- +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); +- vs_push(faslfile); +- fp = faslfile->sm.sm_fp; +- /* seek to beginning of the header */ +- +- HEADER_SEEK(fp); +- +-#ifdef BSD +- fread(&header, sizeof(header), 1, fp); +-#endif +-#ifdef ATT +- fread(&fileheader, sizeof(fileheader), 1, fp); +-#ifdef S3000 +- if(fileheader.f_opthdr != 0) fseek(fp,fileheader.f_opthdr,1); +-#endif +- fread(§ionheader, sizeof(sectionheader), 1, fp); +- textsize = sectionheader.s_size; +- textstart = sectionheader.s_scnptr; +- fread(§ionheader, sizeof(sectionheader), 1, fp); +- datasize = sectionheader.s_size; +- fread(§ionheader, sizeof(sectionheader), 1, fp); +- if (strcmp(sectionheader.s_name, ".bss") == 0) +- bsssize = sectionheader.s_size; +- else +- bsssize = 0; +-#endif +-#ifdef E15 +- fread(&header, sizeof(header), 1, fp); +-#endif +- +- memory=new_cfdata(); +- memory->cfd.cfd_size = textsize + datasize + bsssize; +- vs_push(memory); +- /* If the file is smaller than the space asked for, typically the file +- is an invalid object file */ +- if (file_len(fp)*4 < memory->cfd.cfd_size) +- FEerror("Invalid object file stream: ~a",1,faslfile); +- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, +- memory->cfd.cfd_size,sizeof(double)); +- +-#ifdef SEEK_TO_END_OFILE +-SEEK_TO_END_OFILE(fp); +-#else +-#ifdef BSD +- fseek(fp, +- header.a_text+header.a_data+ +- header.a_syms+header.a_trsize+header.a_drsize, +- 1); +- fread(&i, sizeof(i), 1, fp); +- fseek(fp, i - sizeof(i), 1); +-#endif +- +-#ifdef ATT +- fseek(fp, +- fileheader.f_symptr + SYMESZ*fileheader.f_nsyms, +- 0); +- fread(&i, sizeof(i), 1, fp); +- fseek(fp, i - sizeof(i), 1); +- while ((i = getc(fp)) == 0) +- ; +- ungetc(i, fp); +-#endif +- +-#ifdef E15 +- fseek(fp, +- header.a_text+header.a_data+ +- header.a_syms+header.a_trsize+header.a_drsize, +- 1); +-#endif +-#endif +- data = read_fasl_vector(faslfile); +- vs_push(data); +- close_stream(faslfile); +- +- sprintf(tempfilename, "/tmp/fasltemp%d", getpid()); +- +-AGAIN: +- +-#ifdef BSD +- LD_COMMAND(command, +- kcl_self, +- memory->cfd.cfd_start, +- filename, +- " ", +- tempfilename); +- if(symbol_value(sLAload_verboseA)!=Cnil) +- printf("start address -T %x ",memory->cfd.cfd_start); +-#endif +-#ifdef ATT +- coerce_to_filename(symbol_value(sSAsystem_directoryA), +- system_directory); +- sprintf(command, +- "%sild %s %d %s %s", +- system_directory, +- kcl_self, +- memory->cfd.cfd_start, +- filename, +- tempfilename); +-#endif +-#ifdef E15 +- coerce_to_filename(symbol_value(sSAsystem_directoryA), +- system_directory); +- sprintf(command, +- "%sild %s %d %s %s", +- system_directory, +- kcl_self, +- memory->cfd.cfd_start, +- filename, +- tempfilename); +-#endif +- +- if (system(command) != 0) +- FEerror("The linkage editor failed.", 0); +- +- tempfile = make_simple_string(tempfilename); +- vs_push(tempfile); +- tempfile = open_stream(tempfile, smm_input, Cnil, sKerror); +- vs_push(tempfile); +- fp = tempfile->sm.sm_fp; +- +- HEADER_SEEK(fp); +- +-#ifdef BSD +- fread(&newheader, sizeof(header), 1, fp); +- if (newbsssize != bsssize) { +- insert_contblock(memory->cfd.cfd_start, memory->cfd.cfd_size); +- bsssize = newbsssize; +- memory->cfd.cfd_start = NULL; +- memory->cfd.cfd_size = textsize + datasize + bsssize; +- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,memory->cfd.cfd_size, +- sizeof( double)); +- close_stream(tempfile); +- unlink(tempfilename); +- goto AGAIN; +- } +-#endif +- +- if (fseek(fp, textstart, 0) < 0) +- error("file seek error"); +- +- fread(memory->cfd.cfd_start, textsize + datasize, 1, fp); +- +- close_stream(tempfile); +- +- unlink(tempfilename); +- +- call_init(0,memory,data,0); +- +- vs_base = old_vs_base; +- vs_top = old_vs_top; +- +- return(memory->cfd.cfd_size); +-} ++#error must define SFASL + #endif /* ifndef SFASL */ + + #ifndef __svr4__ diff --git a/patches/Version_2_6_13pre55 b/patches/Version_2_6_13pre55 new file mode 100644 index 00000000..6b4b7828 --- /dev/null +++ b/patches/Version_2_6_13pre55 @@ -0,0 +1,132 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-67) unstable; urgency=medium + . + * Version_2_6_13pre55 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-03 + +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -374,3 +374,5 @@ EXTER gmp_randfnptr_t Mersenne_Twister_G + #endif + + #define collect(p_,f_) (p_)=&(*(p_)=(f_))->c.c_cdr ++#define READ_STREAM_OR_FASD(strm_) \ ++ type_of(strm_)==t_stream ? read_object_non_recursive(strm_) : fSread_fasd_top(strm_) +--- gcl-2.6.12.orig/o/cmpaux.c ++++ gcl-2.6.12/o/cmpaux.c +@@ -363,7 +363,7 @@ do_init(object *statVV) { + + if (ch!='\n') { + struct fasd * fd; +- faslfile=FFN(fSopen_fasd)(faslfile,sKinput,OBJNULL,Cnil); ++ faslfile=fSopen_fasd(faslfile,sKinput,OBJNULL,Cnil); + fd=(struct fasd *)faslfile->v.v_self; + n=fix(fd->table_length); + fd->table->v.v_self=alloca(n*sizeof(object)); +@@ -371,7 +371,7 @@ do_init(object *statVV) { + fd->table->v.v_dim=faslfile->v.v_self[1]->v.v_fillp=n; + } + +- n=fix(type_of(faslfile)==t_stream ? read_object(faslfile) : FFN(fSread_fasd_top)(faslfile)); ++ n=fix(READ_STREAM_OR_FASD(faslfile)); + sSPinit->s.s_dbind=fasl_vec=fSmake_vector1_1(n,aet_object,Cnil); + + /* switch SPinit to point to a vector of function addresses */ +@@ -395,9 +395,9 @@ do_init(object *statVV) { + */ + /* Now we can run the forms f1 f2 in form= (%init f1 f2 ...) */ + +- FFN(fSload_stream)(faslfile,Cnil); ++ fSload_stream(faslfile,Cnil); + if (type_of(faslfile)!=t_stream) +- FFN(fSclose_fasd)(faslfile); ++ fSclose_fasd(faslfile); + + } + +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -561,6 +561,13 @@ DEFUN_NEW("READ-FASD-TOP",object,fSread_ + { RESTORE_FASD; + return result;} + } ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fSread_fasd_top(object x) { ++ return FFN(fSread_fasd_top)(x); ++} ++#endif ++ + + object sLeq; + object sSPinit; +@@ -618,6 +625,12 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd + fd->table_length=current_fasd.table_length; + return result; + }} ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fSopen_fasd(object stream, object direction, object eof, object tabl) { ++ return FFN(fSopen_fasd)(stream,direction,eof,tabl); ++} ++#endif + + DEFUN_NEW("CLOSE-FASD",object,fSclose_fasd,SI,1,1,NONE,OO,OO,OO,OO,(object ar),"") + /* static object */ +@@ -649,6 +662,12 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa + return ar; + + } ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fSclose_fasd(object ar) { ++ return FFN(fSclose_fasd)(ar); ++} ++#endif + + + #define HASHP(x) 1 +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -1645,8 +1645,7 @@ DEFUN_NEW("LOAD-STREAM",object,fSload_st + for (;;) { + preserving_whitespace_flag = FALSE; + detect_eos_flag = TRUE; +- x = type_of(strm)==t_stream ? read_object_non_recursive(strm) : FFN(fSread_fasd_top)(strm); +- if (x == OBJNULL) ++ if ((x = READ_STREAM_OR_FASD(strm))==OBJNULL) + break; + { + object *base = vs_base, *top = vs_top, *lex = lex_env; +@@ -1672,6 +1671,12 @@ DEFUN_NEW("LOAD-STREAM",object,fSload_st + RETURN1(Ct); + + } ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fSload_stream(object strm,object print) { ++ return FFN(fSload_stream)(strm,print); ++} ++#endif + + DEFUN_NEW("LOAD-FASL",object,fSload_fasl,SI,2,2,NONE,OO,OO,OO,OO,(object fasl_filename,object print),"") { + diff --git a/patches/Version_2_6_13pre56 b/patches/Version_2_6_13pre56 new file mode 100644 index 00000000..94a7be89 --- /dev/null +++ b/patches/Version_2_6_13pre56 @@ -0,0 +1,107 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-67) unstable; urgency=medium + . + * Version_2_6_13pre55 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-04 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h ++++ gcl-2.6.12/h/elf64_alpha_reloc.h +@@ -22,16 +22,14 @@ + store_val(where,MASK(32),s+a); + break; + case R_ALPHA_LITERAL: +- s+=a; +- if (a || !(sym->st_other&0x1)) {gotp+=1+(sym->st_other>>1);sym->st_other|=1;} +- gote=got+(a ? gotp : sym->st_size)-1; +- massert(s); ++ gote=got+(a>>32)-1; ++ a&=MASK(32); + if (s>=ggot1 && sst_other=sym->st_size=0; + ++ for (sec=sec1;secsh_type==SHT_RELA) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++ /*unlikely to save got space by recording possible holes in addend range*/ ++ if ((a=r->r_addend+1)>sym->st_other) ++ sym->st_other=a; ++ ++ } ++ + for (*gs=0,sec=sec1;secsh_type==SHT_RELA) + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +@@ -78,13 +90,19 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + + sym=sym1+ELF_R_SYM(r->r_info); + +- if (!sym->st_size || r->r_addend) { +- q=++*gs; +- if (!sym->st_size) sym->st_size=q; ++ if (sym->st_other) { ++ sym->st_size=++*gs; + massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- sym->st_other=(*gs-q)<<1; ++ massert((*gs-sym->st_size) || !r->r_addend); ++ if (sym->st_other>1) ++ (*gs)+=sym->st_other-1; ++ sym->st_other=0; + } + ++ b=sizeof(r->r_addend)*4; ++ massert(!(r->r_addend>>b)); ++ r->r_addend|=((sym->st_size+r->r_addend)< + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-68) unstable; urgency=medium + . + * Version_2_6_13pre57 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-04 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -93,7 +93,7 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + if (sym->st_other) { + sym->st_size=++*gs; + massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- massert((*gs-sym->st_size) || !r->r_addend); ++ massert(!(*gs-sym->st_size) || !r->r_addend); + if (sym->st_other>1) + (*gs)+=sym->st_other-1; + sym->st_other=0; diff --git a/patches/Version_2_6_13pre58 b/patches/Version_2_6_13pre58 new file mode 100644 index 00000000..ec37b831 --- /dev/null +++ b/patches/Version_2_6_13pre58 @@ -0,0 +1,86 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-68) unstable; urgency=medium + . + * Version_2_6_13pre57 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-09 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -65,7 +65,7 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + Sym *sym; + Shdr *sec; + void *v,*ve; +- ul q=0,a; ++ ul a,b; + + for (sym=sym1;symst_other=sym->st_size=0; +--- gcl-2.6.12.orig/o/cmpaux.c ++++ gcl-2.6.12/o/cmpaux.c +@@ -348,6 +348,8 @@ call_init(int init_address,object memory + + */ + ++object *min_cfd_self=NULL; ++ + void + do_init(object *statVV) { + +@@ -386,6 +388,8 @@ do_init(object *statVV) { + } + + data->cfd.cfd_self = statVV; ++ if (!min_cfd_self || data->cfd.cfd_selfcfd.cfd_self; + data->cfd.cfd_fillp= n; + statVV[n-1] = data; + +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -640,7 +640,7 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa + if (type_of(fd->table)==t_vector) + /* input uses a vector */ + {if (fd->table->v.v_self) +- fd->table->v.v_dim=0;/*self can be on the stack, and others write there*/ ++ gset(fd->table->v.v_self,0,fix(fd->index),aet_object); + } + else + if(fd->direction==sKoutput) +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -446,6 +446,7 @@ mark_object_address(object *o,int f) { + + static ufixnum lp; + static ufixnum lr; ++ extern object *min_cfd_self; + + ufixnum p=page(o); + +@@ -455,7 +456,7 @@ mark_object_address(object *o,int f) { + #ifdef SGC + sgc_enabled ? WRITABLE_PAGE_P(lp) : + #endif +- 1; ++ (o>=min_cfd_self && o<((object *)core_end)); + } + + if (lr) diff --git a/patches/Version_2_6_13pre59 b/patches/Version_2_6_13pre59 new file mode 100644 index 00000000..a5e7a2d9 --- /dev/null +++ b/patches/Version_2_6_13pre59 @@ -0,0 +1,88 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-69) unstable; urgency=medium + . + * Version_2_6_13pre58 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-12 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -61,47 +61,30 @@ find_special_params(void *v,Shdr *sec1,S + static int + label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { + +- Rela *r; ++ Rela *r,*rr; + Sym *sym; + Shdr *sec; +- void *v,*ve; +- ul a,b; +- +- for (sym=sym1;symst_other=sym->st_size=0; +- +- for (sec=sec1;secsh_type==SHT_RELA) +- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { +- +- sym=sym1+ELF_R_SYM(r->r_info); +- +- /*unlikely to save got space by recording possible holes in addend range*/ +- if ((a=r->r_addend+1)>sym->st_other) +- sym->st_other=a; +- +- } ++ void *v,*ve,*vv; ++ ul b,q; + + for (*gs=0,sec=sec1;secsh_type==SHT_RELA) + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { + +- sym=sym1+ELF_R_SYM(r->r_info); +- +- if (sym->st_other) { +- sym->st_size=++*gs; +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- massert(!(*gs-sym->st_size) || !r->r_addend); +- if (sym->st_other>1) +- (*gs)+=sym->st_other-1; +- sym->st_other=0; +- } ++ for (rr=vv=v-sec->sh_entsize; ++ vv>=v1 && ++ (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || ++ ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || ++ rr->r_addend!=r->r_addend); ++ vv-=sec->sh_entsize,rr=vv); + + b=sizeof(r->r_addend)*4; ++ q=vv>=v1 ? (rr->r_addend>>b) : ++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ massert(*gs==q || !r->r_addend); + massert(!(r->r_addend>>b)); +- r->r_addend|=((sym->st_size+r->r_addend)<r_addend|=(q< + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-6) unstable; urgency=medium + . + * Version_2_6_13pre5 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -254,8 +254,10 @@ empty_relblock(void) { + object o=sSAleaf_collection_thresholdA->s.s_dbind; + + sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(0); +- for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;) ++ for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;) { ++ tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); ++ } + sSAleaf_collection_thresholdA->s.s_dbind=o; + + } +@@ -498,10 +500,10 @@ static int + rebalance_maxpages(struct typemanager *my_tm,fixnum z) { + + fixnum d; +- ufixnum i,j; ++ ufixnum i,j,r=(my_tm->tm_type==t_relocatable ? 2 : 1); + + +- d=(z-my_tm->tm_maxpage)*(my_tm->tm_type==t_relocatable ? 2 : 1); ++ d=(z-my_tm->tm_maxpage)*r; + j=sum_maxpages(); + + if (j+d>phys_pages) { +@@ -517,14 +519,14 @@ rebalance_maxpages(struct typemanager *m + if (e+phys_pages-j<=0) + return 0; + +- f=1.0-(double)e/k; ++ f=k ? 1.0-(double)e/k : 1.0; + + for (i=t_start;itm_maxpage+(phys_pages-sum_maxpages()))/(my_tm->tm_type==t_relocatable ? 2 : 1))); ++ massert(set_tm_maxpage(my_tm,(my_tm->tm_maxpage*r+(phys_pages-sum_maxpages()))/r)); + + return 1; + +@@ -624,7 +626,12 @@ expand_contblock_index_space(void) { + + if (cbv->v.v_fillp+1==cbv->v.v_dim) { + +- void *v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum)); ++ void *v; ++ object o=sSAleaf_collection_thresholdA->s.s_dbind; ++ ++ sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(-1); ++ v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum)); ++ sSAleaf_collection_thresholdA->s.s_dbind=o; + + memcpy(v,cbv->v.v_self,cbv->v.v_dim*sizeof(fixnum)); + cbv->v.v_self=v; +@@ -731,13 +738,14 @@ insert_contblock(void *p,ufixnum s) { + + cbp->cb_size=s; + cbp->cb_link=*cbpp; +- *cbpp=cbp; + + if ((!cbp->cb_link || cbp->cb_link->cb_size!=s)) { + cbppp=expand_contblock_index(cbppp); + cbppp[1]=&cbp->cb_link; + } + ++ *cbpp=cbp; ++ + } + + static inline void +@@ -890,6 +898,7 @@ add_pages(struct typemanager *tm,fixnum + if (rb_pointer>rb_end) { + fprintf(stderr,"Moving relblock low before expanding relblock pages\n"); + fflush(stderr); ++ tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + nrbpage+=m; +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -1042,14 +1042,10 @@ contblock_sweep_phase(void) { + + struct pageinfo *v; + STATIC char *s, *e, *p, *q; +- object o; + ufixnum i; + + reset_contblock_freelist(); + +- o=sSAleaf_collection_thresholdA->s.s_dbind; +- sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(-1); +- + for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) { + + bool z; +@@ -1074,8 +1070,6 @@ contblock_sweep_phase(void) { + + } + +- sSAleaf_collection_thresholdA->s.s_dbind=o; +- + sweep_link_array(); + + } +@@ -1646,14 +1640,18 @@ DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE + + /* 1 args */ + +- if (x0 == Ct) ++ if (x0 == Ct) { ++ tm_table[t_contiguous].tm_adjgbccnt--; + GBC(t_other); +- else if (x0 == Cnil) ++ } else if (x0 == Cnil) { ++ tm_table[t_cons].tm_adjgbccnt--; + GBC(t_cons); +- else if (eql(small_fixnum(0),x0)) ++ } else if (eql(small_fixnum(0),x0)) { ++ tm_table[t_contiguous].tm_adjgbccnt--; + GBC(t_contiguous); +- else { ++ } else { + x0 = small_fixnum(1); ++ tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } + RETURN1(x0); diff --git a/patches/Version_2_6_13pre60 b/patches/Version_2_6_13pre60 new file mode 100644 index 00000000..e5808329 --- /dev/null +++ b/patches/Version_2_6_13pre60 @@ -0,0 +1,61 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-70) unstable; urgency=medium + . + * Version_2_6_13pre59 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-12 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h ++++ gcl-2.6.12/h/elf64_alpha_reloc.h +@@ -29,7 +29,7 @@ + } else + *gote=s+a; + s=(gote-got)*sizeof(*got); +- massert(!(s&~MASK(16))); ++ massert(!(s&~MASK(15))); + store_val(where,MASK(16),s); + break; + case R_ALPHA_GPRELHIGH: +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -62,7 +62,6 @@ static int + label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { + + Rela *r,*rr; +- Sym *sym; + Shdr *sec; + void *v,*ve,*vv; + ul b,q; +@@ -80,8 +79,12 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + vv-=sec->sh_entsize,rr=vv); + + b=sizeof(r->r_addend)*4; +- q=vv>=v1 ? (rr->r_addend>>b) : ++*gs; +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ if (vv>=v1) ++ q=rr->r_addend>>b; ++ else { ++ q=++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym1+ELF_R_SYM(r->r_info),st1,gs)); ++ } + massert(*gs==q || !r->r_addend); + massert(!(r->r_addend>>b)); + r->r_addend|=(q< + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-71) unstable; urgency=medium + . + * Version_2_6_13pre60 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-13 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4118,6 +4118,7 @@ if test "${enable_gprof+set}" = set; the + $as_echo_n "checking working gprof... " >&6; } + case $use in + powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; ++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -331,6 +331,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + AC_MSG_CHECKING([working gprof]) + case $use in + powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; ++ s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; diff --git a/patches/Version_2_6_13pre62 b/patches/Version_2_6_13pre62 new file mode 100644 index 00000000..c7d4c3c9 --- /dev/null +++ b/patches/Version_2_6_13pre62 @@ -0,0 +1,113 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-72) unstable; urgency=medium + . + * Version_2_6_13pre61 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-14 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h ++++ gcl-2.6.12/h/elf64_alpha_reloc.h +@@ -22,12 +22,12 @@ + store_val(where,MASK(32),s+a); + break; + case R_ALPHA_LITERAL: +- gote=got+(a>>32)-1; +- a&=MASK(32); ++ massert(a || sym->st_size); ++ gote=got+(a ? (a>>32) : sym->st_size)-1; + if (s>=ggot1 && sst_size=0; + + for (*gs=0,sec=sec1;secsh_type==SHT_RELA) +- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { +- +- for (rr=vv=v-sec->sh_entsize; +- vv>=v1 && +- (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || +- ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || +- rr->r_addend!=r->r_addend); +- vv-=sec->sh_entsize,rr=vv); +- +- b=sizeof(r->r_addend)*4; +- if (vv>=v1) +- q=rr->r_addend>>b; +- else { +- q=++*gs; +- massert(!make_got_room_for_stub(sec1,sece,sym1+ELF_R_SYM(r->r_info),st1,gs)); ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ ++ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++ ++ if (sec->sh_type!=SHT_RELA || !r->r_addend) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++ if (!sym->st_size) { ++ sym->st_size=++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); + } +- massert(*gs==q || !r->r_addend); +- massert(!(r->r_addend>>b)); +- r->r_addend|=(q<sh_entsize; ++ vv>=v1 && (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || ++ ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || ++ rr->r_addend!=r->r_addend); ++ vv-=sec->sh_entsize,rr=vv); ++ ++ q=vvr_addend>>32; ++ massert(!(r->r_addend>>32)); ++ r->r_addend|=(q<<32); + + } +- ++ ++ } ++ + return 0; + + } diff --git a/patches/Version_2_6_13pre63 b/patches/Version_2_6_13pre63 new file mode 100644 index 00000000..ee53ae96 --- /dev/null +++ b/patches/Version_2_6_13pre63 @@ -0,0 +1,78 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-73) unstable; urgency=medium + . + * Version_2_6_13pre62 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-17 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -71,20 +71,21 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + sym->st_size=0; + + for (*gs=0,sec=sec1;secsh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (sec->sh_type==SHT_RELA || sec->sh_type==SHT_REL) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + +- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++ if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { + +- if (sec->sh_type!=SHT_RELA || !r->r_addend) { ++ if (sec->sh_type!=SHT_RELA || !r->r_addend) { + +- sym=sym1+ELF_R_SYM(r->r_info); ++ sym=sym1+ELF_R_SYM(r->r_info); + +- if (!sym->st_size) { +- sym->st_size=++*gs; +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); +- } ++ if (!sym->st_size) { ++ sym->st_size=++*gs; ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ } + +- } else { ++ } else { + + for (rr=vv=v-sec->sh_entsize; + vv>=v1 && (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || +@@ -96,9 +97,9 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + massert(!(r->r_addend>>32)); + r->r_addend|=(q<<32); + +- } ++ } + +- } ++ } + + return 0; + +--- gcl-2.6.12.orig/o/gprof.c ++++ gcl-2.6.12/o/gprof.c +@@ -1,3 +1,5 @@ ++#include ++ + #include "include.h" + #include "page.h" + #include "ptable.h" diff --git a/patches/Version_2_6_13pre64 b/patches/Version_2_6_13pre64 new file mode 100644 index 00000000..e0a6ae0c --- /dev/null +++ b/patches/Version_2_6_13pre64 @@ -0,0 +1,169 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-74) unstable; urgency=medium + . + * Version_2_6_13pre63 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-21 + +--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h ++++ gcl-2.6.12/h/elf64_alpha_reloc.h +@@ -1,16 +1,14 @@ + case R_ALPHA_GPDISP: +- s=(ul)got; +- s-=p; +- s+=(s&0x8000)<<1; +- store_val(where,MASK(16),s>>16); +- where=(void *)where+a; +- store_val(where,MASK(16),s); ++ gotoff=(ul)(got+(a>>32)); ++ s=gotoff-p; ++ store_val(where,MASK(16),(s-(short)s)>>16); ++ store_val((void *)where+(a&MASK(32)),MASK(16),s); + break; + case R_ALPHA_SREL32: + store_val(where,MASK(32),s+a-p); + break; + case R_ALPHA_GPREL32: +- store_val(where,MASK(32),s+a-(ul)got); ++ store_val(where,MASK(32),s+a-gotoff); + break; + case R_ALPHA_LITUSE: + case R_ALPHA_HINT: +@@ -22,23 +20,20 @@ + store_val(where,MASK(32),s+a); + break; + case R_ALPHA_LITERAL: +- massert(a || sym->st_size); +- gote=got+(a ? (a>>32) : sym->st_size)-1; ++ s+=a&MASK(32); ++ a=(a>>32)-1; + if (s>=ggot1 && s>16); ++ s+=a-gotoff; ++ store_val(where,MASK(16),(s-(short)s)>>16); + break; + case R_ALPHA_GPRELLOW: +- store_val(where,MASK(16),s+a-(ul)got); ++ store_val(where,MASK(16),s+a-gotoff); + break; + case R_ALPHA_TLS_GD_HI: + store_vals(where,MASK(21),((long)(s+a-(p+4)))>>2); +--- gcl-2.6.12.orig/h/elf64_alpha_reloc_special.h ++++ gcl-2.6.12/h/elf64_alpha_reloc_special.h +@@ -1,4 +1,4 @@ +-static ul ggot1,ggote; ++static ul ggot1,ggote,gotoff; + + static int + write_stub(ul s,ul *got,ul *gote) { +@@ -61,44 +61,60 @@ find_special_params(void *v,Shdr *sec1,S + static int + label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { + +- Sym *sym; +- Rela *r,*rr; ++ Sym *sym,*fsym=sym1; ++ Rela *r; + Shdr *sec; +- void *v,*ve,*vv; +- ul q; ++ void *v,*ve; ++ ul q,gotp; + + for (sym=sym1;symst_size=0; + +- for (*gs=0,sec=sec1;secsh_type==SHT_RELA || sec->sh_type==SHT_REL) ++ for (*gs=gotp=0,sec=sec1;secsh_type==SHT_RELA) + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + +- if (ELF_R_TYPE(r->r_info)==R_ALPHA_LITERAL) { ++ switch(ELF_R_TYPE(r->r_info)) { ++ ++ case R_ALPHA_LITERAL: + +- if (sec->sh_type!=SHT_RELA || !r->r_addend) { ++ if (!r->r_addend) { + + sym=sym1+ELF_R_SYM(r->r_info); ++ q=(gotp-sym->st_size)*sizeof(*gs); + +- if (!sym->st_size) { ++ if (!sym->st_size || q!=(short)q) { + sym->st_size=++*gs; + massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); + } + +- } else { ++ q=sym->st_size; ++ ++ } else ++ ++ q=++*gs; ++ ++ massert(!(r->r_addend>>32)); ++ r->r_addend|=(q<<32); + +- for (rr=vv=v-sec->sh_entsize; +- vv>=v1 && (ELF_R_TYPE(rr->r_info)!=ELF_R_TYPE(r->r_info) || +- ELF_R_SYM(rr->r_info)!=ELF_R_SYM(r->r_info) || +- rr->r_addend!=r->r_addend); +- vv-=sec->sh_entsize,rr=vv); +- +- q=vvr_addend>>32; +- massert(!(r->r_addend>>32)); +- r->r_addend|=(q<<32); ++ q=(q-gotp)*sizeof(*gs); ++ massert(q==(short)q); + ++ break; ++ ++ case R_ALPHA_GPDISP: ++ ++ for (sym=fsym;symst_shndx!=1 || sym->st_value!=r->r_offset);sym++); ++ ++ if (symr_addend|=(gotp<<32); ++ ++ break; ++ + } + + return 0; diff --git a/patches/Version_2_6_13pre65 b/patches/Version_2_6_13pre65 new file mode 100644 index 00000000..dbaef5d7 --- /dev/null +++ b/patches/Version_2_6_13pre65 @@ -0,0 +1,212 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-75) unstable; urgency=medium + . + * Version_2_6_13pre64 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-22 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpif.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpif.lsp +@@ -428,9 +428,8 @@ + (wt-label label)))) + + (if (eq default 't) +- (progn (wt-nl "FEerror(\"The ECASE key value ~s is illegal.\",1,V" cvar ");") +- (unwind-exit nil 'jump)) +- (c2expr default)) ++ (wt-nl "FEerror(\"The ECASE key value ~s is illegal.\",1,V" cvar ");") ++ (c2expr default)) + + (wt "}") + (close-inline-blocks)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp +@@ -221,56 +221,36 @@ + + + (defun c2multiple-value-bind (vars init-form body +- &aux (block-p nil) (labels nil) +- (*unwind-exit* *unwind-exit*) +- (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*) +- top-data) +- (declare (object block-p)) +- (multiple-value-check vars init-form) ++ &aux (block-p nil) ++ (*unwind-exit* *unwind-exit*) ++ (*vs* *vs*) (*clink* *clink*) (*ccb-vs* *ccb-vs*) ++ top-data) + +- (dolist** (var vars) ++ (multiple-value-check vars init-form) ++ ++ (dolist (var vars) + (let ((kind (c2var-kind var))) +- (declare (object kind)) + (if kind + (let ((cvar (next-cvar))) + (setf (var-kind var) kind) + (setf (var-loc var) cvar) + (wt-nl) + (unless block-p (wt "{") (setq block-p t)) +- (wt-var-decl var) +- ) +- (setf (var-ref var) (vs-push))))) ++ (wt-var-decl var)) ++ (setf (var-ref var) (vs-push))))) + + (let ((*value-to-go* 'top) *top-data*) + (c2expr* init-form) (setq top-data *top-data*)) ++ + (and *record-call-info* (record-call-info nil (car top-data))) +- (let ((*clink* *clink*) +- (*unwind-exit* *unwind-exit*) +- (*ccb-vs* *ccb-vs*)) +- (do ((vs vars (cdr vs))) +- ((endp vs)) +- (declare (object vs)) +- (push (next-label) labels) +- (wt-nl "if(vs_base>=vs_top){") +- (reset-top) +- (wt-go (car labels)) (wt "}") ++ ++ (wt-nl "if(vs_base>vs_top) vs_top=vs_base;*vs_top=Cnil;") ++ (do ((vs vars (cdr vs))) ++ ((endp vs)) + (c2bind-loc (car vs) '(vs-base 0)) +- (unless (endp (cdr vs)) (wt-nl "vs_base++;")))) ++ (unless (endp (cdr vs)) (wt-nl "if (vs_base>32)); ++ gotoff=(ul)(got+(a>>32)-1); + s=gotoff-p; + store_val(where,MASK(16),(s-(short)s)>>16); + store_val((void *)where+(a&MASK(32)),MASK(16),s); +@@ -23,7 +23,7 @@ + s+=a&MASK(32); + a=(a>>32)-1; + if (s>=ggot1 && sr_addend>>32)); ++ if (r->r_addend>>32) ++ fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); ++ r->r_addend&=0xffffffff; ++ massert((q&0xffffffff)==q); + r->r_addend|=(q<<32); + + q=(q-gotp)*sizeof(*gs); +@@ -111,6 +114,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + gotp=*gs+1; + } + ++ if (r->r_addend>>32) ++ fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); ++ r->r_addend&=0xffffffff; ++ massert((gotp&0xffffffff)==gotp); + r->r_addend|=(gotp<<32); + + break; diff --git a/patches/Version_2_6_13pre66 b/patches/Version_2_6_13pre66 new file mode 100644 index 00000000..667cee3c --- /dev/null +++ b/patches/Version_2_6_13pre66 @@ -0,0 +1,132 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-75) unstable; urgency=medium + . + * Version_2_6_13pre65 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-23 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp +@@ -164,27 +164,21 @@ + (cmpwarn "~A was proclaimed to have only one return value. ~%;But you appear to want multiple values." fname)))))) + + (defun c2multiple-value-setq (vrefs form &aux top-data) +- (multiple-value-check vrefs form) ++ (multiple-value-check vrefs form) + (let ((*value-to-go* 'top)*top-data*) + (c2expr* form) (setq top-data *top-data*)) + (and *record-call-info* (record-call-info nil (car top-data))) ++ (wt-nl "if(vs_base>vs_top) vs_top=vs_base;*vs_top=Cnil;") + (do ((vs vrefs (cdr vs))) + ((endp vs)) +- (declare (object vs)) + (let ((vref (car vs))) +- (declare (object vref)) +- (wt-nl "if(vs_base&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 + $as_echo "ok" >&6; } +- assert_arg_to_cflags -pg ++ OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg ++ assert_arg_to_cflags -pg ++ CFLAGS=$OLD_CFLAGS + TFPFLAG="" + + $as_echo "#define GCL_GPROF 1" >>confdefs.h +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -334,6 +334,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + ia64*) enableval="no";; ++ alpha*) enableval="no";;#write_stub currently depends on t12 set in call + hppa*) enableval="no";; + arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 +@@ -343,25 +344,11 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + AC_MSG_RESULT([disabled]) + else + AC_MSG_RESULT([ok]) +- assert_arg_to_cflags -pg ++ OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg ++ assert_arg_to_cflags -pg ++ CFLAGS=$OLD_CFLAGS + TFPFLAG="" + AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +-dnl AC_MSG_CHECKING([for text start]) +-dnl echo 'int main () {return(0);}' >foo.c +-dnl $CC foo.c -o foo +-dnl GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +-dnl rm -f foo.c foo +-dnl if test "$GCL_GPROF_START" != "" ; then +-dnl AC_MSG_RESULT($GCL_GPROF_START) +-dnl AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) +-dnl assert_arg_to_cflags -pg +-dnl # case $use in +-dnl # s390*) ;; # relocation truncation bug in gcc +-dnl # *) TLIBS="$TLIBS -pg";; +-dnl # esac +-dnl TFPFLAG="" +-dnl AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +-dnl fi + fi + fi]) + +--- gcl-2.6.12.orig/o/usig.c ++++ gcl-2.6.12/o/usig.c +@@ -150,7 +150,7 @@ DEFUN_NEW("FLD",object,fSfld,SI,1,1,NONE + + /* For now ignore last three args governing offsets and data modification, just to + support fpe sync with master*/ +-DEFUN_NEW("*FIXNUM",object,fSAfixnum,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { ++DEFUN_NEW("*FIXNUM",object,fSAfixnum,SI,4,4,NONE,II,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { + RETURN1((object)*(fixnum *)addr); + } + DEFUN_NEW("*FLOAT",object,fSAfloat,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { diff --git a/patches/Version_2_6_13pre67 b/patches/Version_2_6_13pre67 new file mode 100644 index 00000000..274a39e0 --- /dev/null +++ b/patches/Version_2_6_13pre67 @@ -0,0 +1,256 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-76) unstable; urgency=medium + . + * Version_2_6_13pre66 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-03-26 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4121,7 +4121,6 @@ $as_echo_n "checking working gprof... " + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + ia64*) enableval="no";; +- alpha*) enableval="no";;#write_stub currently depends on t12 set in call + hppa*) enableval="no";; + arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -334,7 +334,6 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; + ia64*) enableval="no";; +- alpha*) enableval="no";;#write_stub currently depends on t12 set in call + hppa*) enableval="no";; + arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 +--- gcl-2.6.12.orig/h/elf64_alpha_reloc.h ++++ gcl-2.6.12/h/elf64_alpha_reloc.h +@@ -1,14 +1,14 @@ + case R_ALPHA_GPDISP: +- gotoff=(ul)(got+(a>>32)-1); ++ gotoff=(ul)(got+HIGH(a)-1); + s=gotoff-p; + store_val(where,MASK(16),(s-(short)s)>>16); +- store_val((void *)where+(a&MASK(32)),MASK(16),s); ++ store_val((void *)where+LOW(a),MASK(16),s); + break; + case R_ALPHA_SREL32: + store_val(where,MASK(32),s+a-p); + break; + case R_ALPHA_GPREL32: +- store_val(where,MASK(32),s+a-gotoff); ++ store_val(where,MASK(32),s+LOW(a)-(ul)(got+HIGH(a)-1)); + break; + case R_ALPHA_LITUSE: + case R_ALPHA_HINT: +@@ -20,8 +20,8 @@ + store_val(where,MASK(32),s+a); + break; + case R_ALPHA_LITERAL: +- s+=a&MASK(32); +- a=(a>>32)-1; ++ s+=LOW(a); ++ a=HIGH(a)-1; + if (s>=ggot1 && s>16); /*ldah t12,(symhigh)(zero)*/ ++ *goti++=(0x8<<26)|(0x1b<<21)|(0x1b<<16)|(s&MASK(16)); /*lda t12,(symlow)(t12)*/ ++ *goti++=(0x29<<26)|(0x1b<<21)|(0x1b<<16)|0; /*ldq t12,0(t12)*/ ++ *goti++=(0x1a<<26)|(0x1f<<21)|(0x1b<<16)|0x4000; /*jsr zero,(t12),$pc+4*/ ++ *goti++=0; /*halt*/ ++ *goti++=0; /*halt*/ ++ ++ return 0; ++ ++} + + static int + write_stub(ul s,ul *gote) { + + unsigned int *goti; + ++ if (s==mcount) ++ return write_stub_mcount(mcount,gote); ++ + *gote=(ul)(goti=(void *)(gote+2)); + *++gote=s; + *goti++=(0x29<<26)|(0x1b<<21)|(0x1b<<16)|0xfff8; /*ldq t12,-8(t12)*/ +@@ -35,15 +57,19 @@ static int + find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, + const char *st1,Sym *ds1,Sym *dse,Sym *sym1,Sym *syme) { + ++ Sym *sym; + Shdr *sec; + Rela *r; +- void *ve; ++ void *ve,*dst1; + + massert((sec=get_section(".got",sec1,sece,sn))); + + ggot1=sec->sh_addr; + ggote=ggot1+sec->sh_size; + ++ massert(sec=get_section(".dynstr",sec1,sece,sn));/*FIXME pass as parameter*/ ++ dst1=v+sec->sh_offset; ++ + massert((sec=get_section(".rel.dyn",sec1,sece,sn))|| + (sec=get_section(".rela.dyn",sec1,sece,sn))); + +@@ -51,13 +77,20 @@ find_special_params(void *v,Shdr *sec1,S + ve=v+sec->sh_size; + + for (r=v;vsh_entsize,r=v) +- if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) +- ds1[ELF_R_SYM(r->r_info)].st_value=r->r_offset; ++ if (ELF_R_TYPE(r->r_info) && !(sym=ds1+ELF_R_SYM(r->r_info))->st_value) { ++ sym->st_value=r->r_offset; ++ if (!strncmp("_mcount",dst1+sym->st_name,7)) ++ mcount=sym->st_value; ++ } + + return 0; + + } + ++#define HIGH(a_) ((a_)>>32) ++#define LOW(a_) ((a_)&MASK(32)) ++#define SET_HIGH(a_,b_) ({ul _a=(a_);(a_)=((b_)<<32)|LOW(_a);}) ++ + static int + label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { + +@@ -67,12 +100,18 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + void *v,*ve; + ul q,gotp; + +- for (sym=sym1;symst_size=0; ++ for (sym=sym1;symst_value)); ++ massert(!HIGH(sym->st_size)); ++ } + + for (*gs=gotp=0,sec=sec1;secsh_type==SHT_RELA) +- for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) { ++ ++ if (HIGH(r->r_addend)) ++ fprintf(stderr,"zeroing high addend %lx\n",HIGH(r->r_addend));/*never reached fix(Cnil) code, to be eliminated*/ ++ SET_HIGH(r->r_addend,0UL); + + switch(ELF_R_TYPE(r->r_info)) { + +@@ -81,49 +120,60 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + if (!r->r_addend) { + + sym=sym1+ELF_R_SYM(r->r_info); +- q=(gotp-sym->st_size)*sizeof(*gs); ++ q=(HIGH(sym->st_size)-gotp)*sizeof(*gs); + +- if (!sym->st_size || q!=(short)q) { +- sym->st_size=++*gs; ++ if (!HIGH(sym->st_size) || q!=(short)q) {/*new cached got entry if first or out of range*/ ++ SET_HIGH(sym->st_size,++*gs); + massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); + } + +- q=sym->st_size; ++ q=HIGH(sym->st_size); + + } else + + q=++*gs; + +- if (r->r_addend>>32) +- fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); +- r->r_addend&=0xffffffff; +- massert((q&0xffffffff)==q); +- r->r_addend|=(q<<32); ++ SET_HIGH(r->r_addend,q); + +- q=(q-gotp)*sizeof(*gs); ++ q=(q-gotp)*sizeof(*gs);/*check 16bit range gprel address in range*/ + massert(q==(short)q); + + break; + + case R_ALPHA_GPDISP: + +- for (sym=fsym;symst_shndx!=1 || sym->st_value!=r->r_offset);sym++); ++ for (sym=fsym;symst_shndx!=1 || LOW(sym->st_value)!=r->r_offset);sym++);/*ordered search*/ + + if (symst_value,gotp=*gs+1); + } + +- if (r->r_addend>>32) +- fprintf(stderr,"zeroing high addend %lx\n",r->r_addend>>32); +- r->r_addend&=0xffffffff; +- massert((gotp&0xffffffff)==gotp); +- r->r_addend|=(gotp<<32); ++ SET_HIGH(r->r_addend,gotp); ++ ++ break; ++ ++ case R_ALPHA_GPREL32: ++ ++ q=LOW(sym1[ELF_R_SYM(r->r_info)].st_value)+r->r_addend; ++ ++ /*unordered search*/ ++ for (sym=sym1;symst_shndx!=1 || LOW(sym->st_value)>q || LOW(sym->st_value)+LOW(sym->st_size)r_addend,HIGH(sym->st_value)); + + break; + + } + ++ } ++ ++ for (sym=sym1;symst_value,0UL); ++ SET_HIGH(sym->st_size,0UL); ++ } ++ + return 0; + + } diff --git a/patches/Version_2_6_13pre68 b/patches/Version_2_6_13pre68 new file mode 100644 index 00000000..3c62bd07 --- /dev/null +++ b/patches/Version_2_6_13pre68 @@ -0,0 +1,35 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-76) unstable; urgency=medium + . + * Version_2_6_13pre67 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-07-24 + +--- gcl-2.6.12.orig/h/elf64_i386_reloc.h ++++ gcl-2.6.12/h/elf64_i386_reloc.h +@@ -8,6 +8,7 @@ + add_val(where,~0L,s+a); + break; + case R_X86_64_PC32: ++ case R_X86_64_PLT32: + massert(ovchks(s+a-p,~MASK(32))); + add_val(where,MASK(32),s+a-p); + break; diff --git a/patches/Version_2_6_13pre69 b/patches/Version_2_6_13pre69 new file mode 100644 index 00000000..37f5f682 --- /dev/null +++ b/patches/Version_2_6_13pre69 @@ -0,0 +1,32 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-78) unstable; urgency=medium + . + * rebuild against latest compilers and tools +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-10-11 + +--- gcl-2.6.12.orig/h/386-gnu.h ++++ gcl-2.6.12/h/386-gnu.h +@@ -61,3 +61,4 @@ + #define NEED_STACK_CHK_GUARD + + #undef HAVE_D_TYPE /*FIXME defined, but not implemented in readdir*/ ++#define NO_FILE_LOCKING /*FIXME*/ diff --git a/patches/Version_2_6_13pre7 b/patches/Version_2_6_13pre7 new file mode 100644 index 00000000..ccbd1e45 --- /dev/null +++ b/patches/Version_2_6_13pre7 @@ -0,0 +1,163 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-7) unstable; urgency=medium + . + * Version_2_6_13pre6 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/h/att_ext.h ++++ gcl-2.6.12/h/att_ext.h +@@ -29,7 +29,7 @@ void *malloc(size_t); + void *realloc(void *,size_t); + /* void * memalign(size_t,size_t); */ + void *alloc_contblock(size_t); +-void *alloc_relblock(size_t); ++inline void *alloc_relblock(size_t); + /* object fSallocate_contiguous_pages(); */ + /* object fSallocate_relocatable_pages(); */ + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -7,7 +7,7 @@ + /* alloc.c:364:OF */ extern object on_stack_cons (object x, object y); /* (x, y) object x; object y; */ + /* alloc.c:376:OF */ extern object fSallocated (object typ); /* (typ) object typ; */ + /* alloc.c:401:OF */ extern object fSreset_number_used (object typ); /* (typ) object typ; */ +-/* alloc.c:480:OF */ extern void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */ ++/* alloc.c:480:OF */ extern inline void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */ + /* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p, int s); /* (p, s) char *p; int s; */ + /* alloc.c:611:OF */ extern void set_maxpage (void); /* () */ + /* alloc.c:635:OF */ extern void gcl_init_alloc (void *); /* () */ +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -422,7 +422,11 @@ DEFVAR("*LEAF-COLLECTION-THRESHOLD*",sSA + + static inline bool + marking(void *p) { +- return (sgc_enabled ? ON_WRITABLE_PAGE_CACHED(p) : !NULL_OR_ON_C_STACK(p)); ++ return ( ++#ifdef SGC ++ sgc_enabled ? ON_WRITABLE_PAGE_CACHED(p) : ++#endif ++ !NULL_OR_ON_C_STACK(p)); + } + + static inline bool +@@ -483,7 +487,11 @@ mark_object_address(object *o,int f) { + + if (lp!=p || !f) { + lp=p; +- lr=sgc_enabled ? WRITABLE_PAGE_P(lp) : 1; ++ lr= ++#ifdef SGC ++ sgc_enabled ? WRITABLE_PAGE_P(lp) : ++#endif ++ 1; + } + + if (lr) +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -147,8 +147,8 @@ mbrk(void *v) { + + #include + +-ufixnum +-get_phys_pages_no_malloc(void) { ++static ufixnum ++get_phys_pages_no_malloc(char n) { + MEMORYSTATUS m; + + m.dwLength=sizeof(m); +@@ -161,8 +161,8 @@ get_phys_pages_no_malloc(void) { + + #include + +-ufixnum +-get_phys_pages_no_malloc(void) { ++static ufixnum ++get_phys_pages_no_malloc(char n) { + uint64_t s; + size_t z=sizeof(s); + int m[2]={CTL_HW,HW_MEMSIZE}; +@@ -176,8 +176,8 @@ get_phys_pages_no_malloc(void) { + + #elif defined(__sun__) + +-ufixnum +-get_phys_pages_no_malloc(void) { ++static ufixnum ++get_phys_pages_no_malloc(char n) { + + return sysconf(_SC_PHYS_PAGES); + +@@ -202,7 +202,7 @@ get_proc_meminfo_value_in_pages(const ch + return n>>(PAGEWIDTH-10); + } + +-ufixnum ++static ufixnum + get_phys_pages_no_malloc(char freep) { + return freep ? + get_proc_meminfo_value_in_pages("MemFree:")+ +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -205,9 +205,7 @@ load_memory(struct scnhdr *sec1,struct s + memory->cfd.cfd_size=sz; + memory->cfd.cfd_self=0; + memory->cfd.cfd_start=0; +- prefer_low_mem_contblock=TRUE; +- memory->cfd.cfd_start=alloc_contblock(sz); +- prefer_low_mem_contblock=FALSE; ++ memory->cfd.cfd_start=alloc_code_space(sz); + + for (sec=sec1;secs_paddr+=(ul)memory->cfd.cfd_start; +--- gcl-2.6.12.orig/o/sfaslmacho.c ++++ gcl-2.6.12/o/sfaslmacho.c +@@ -207,9 +207,7 @@ load_memory(struct section *sec1,struct + memory->cfd.cfd_size=sz; + memory->cfd.cfd_self=0; + memory->cfd.cfd_start=0; +- prefer_low_mem_contblock=TRUE; +- memory->cfd.cfd_start=alloc_contblock(sz); +- prefer_low_mem_contblock=FALSE; ++ memory->cfd.cfd_start=alloc_code_space(sz); + + a=(ul)memory->cfd.cfd_start; + a=(a+ma)&~ma; +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -28,7 +28,7 @@ + (pcl (append x (list "pcl"))) + (clcs (append x (list "clcs"))) + (gtk (append x (list "gcl-tk")))) +- (dolist (d (list lsp cmpnew #-pre-gcl xgcl-2 #+(or pcl ansi-cl) pcl #+ansi-cl clcs)) ++ (dolist (d (list lsp cmpnew #+(and xgcl (not pre-gcl)) xgcl-2 #+(or pcl ansi-cl) pcl #+ansi-cl clcs)) + (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d))) + (load (make-pathname :name "tk-package" :type "lsp" :directory gtk)) + (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew)) +@@ -77,6 +77,5 @@ + + #-ansi-cl(use-package :cltl1-compat :lisp) + #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) +-(export '*load-pathname* :si);For maxima, at least as of 5.34.1 + + #+ansi-cl (use-package :pcl :user) diff --git a/patches/Version_2_6_13pre70 b/patches/Version_2_6_13pre70 new file mode 100644 index 00000000..cbcbe0a8 --- /dev/null +++ b/patches/Version_2_6_13pre70 @@ -0,0 +1,108 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-78) unstable; urgency=medium + . + * rebuild against latest compilers and tools + * Version_2_6_13pre69 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-10-29 + +--- gcl-2.6.12.orig/h/linux.h ++++ gcl-2.6.12/h/linux.h +@@ -132,17 +132,10 @@ do { int c = 0; \ + + #include + #include +-#define GET_FULL_PATH_SELF(a_) do { \ +- static char q[PATH_MAX]; \ +- const char *s="/proc/self/exe"; \ +- struct stat ss; \ +- if (stat(s,&ss)) \ +- (a_)=argv[0]; \ +- else { \ +- if (!realpath(s,q)) \ +- error("realpath error"); \ +- (a_)=q; \ +- } \ ++#define GET_FULL_PATH_SELF(a_) do { \ ++ static char q[PATH_MAX]; \ ++ massert(which("/proc/self/exe",q) || which(argv[0],q)); \ ++ (a_)=q; \ + } while(0) + + +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -460,18 +460,49 @@ DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",o + RETURN1((object)(w-u)); + } + ++static int ++mbin(const char *s,char *o) { ++ ++ struct stat ss; ++ ++ if (!stat(s,&ss) && (ss.st_mode&S_IFMT)==S_IFREG && !access(s,R_OK|X_OK)) { ++ massert(realpath(s,o)); ++ return 1; ++ } ++ ++ return 0; ++ ++} ++ ++static int ++which(const char *n,char *o) { ++ ++ char *s; ++ ++ if (strchr(n,'/')) ++ return mbin(n,o); ++ ++ massert(snprintf(FN1,sizeof(FN1),"%s",getenv("PATH"))>1); ++ for (s=NULL;(s=strtok(s ? NULL : FN1,":"));) { ++ ++ massert(snprintf(FN2,sizeof(FN2),"%s/%s",s,n)); ++ if (mbin(FN2,o)) ++ return 1; ++ ++ } ++ ++ return 0; ++ ++} ++ ++ + + int + main(int argc, char **argv, char **envp) { + +-#ifdef GET_FULL_PATH_SELF + GET_FULL_PATH_SELF(kcl_self); +-#else +- kcl_self = argv[0]; +-#endif +- + *argv=kcl_self; +- ++ + #ifdef CAN_UNRANDOMIZE_SBRK + #include + #include diff --git a/patches/Version_2_6_13pre71 b/patches/Version_2_6_13pre71 new file mode 100644 index 00000000..f0013e6f --- /dev/null +++ b/patches/Version_2_6_13pre71 @@ -0,0 +1,59 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-79) unstable; urgency=medium + . + * Version_2_6_13pre70 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-10-30 + +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -879,9 +879,9 @@ void hppa_save_regs(struct regs); + + asm(".code"); + asm(".export hppa_save_regs, entry"); ++ asm(".label hppa_save_regs"); + asm(".proc"); + asm(".callinfo"); +- asm(".label hppa_save_regs"); + asm(".entry"); + + asm("stw %r3,0(%arg0)"); +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -242,7 +242,7 @@ get_gc_environ(void) { + } + + gc_page_min=0.5; +- if ((e=getenv("GCL_GC_PAGE_MIN"))) { ++ if ((e=getenv("GCL_GC_PAGE_MIN"))||(e=getenv("GCL_GC_PAGE_THRESH"))) {/*legacy support*/ + massert(sscanf(e,"%lf",&gc_page_min)==1); + massert(gc_page_min>=0.0); + } +@@ -253,7 +253,8 @@ get_gc_environ(void) { + massert(gc_page_max>=0.0); + } + +- multiprocess_memory_pool=(e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && *e; ++ multiprocess_memory_pool= ++ (e=getenv("GCL_MULTIPROCESS_MEMORY_POOL")) && (*e=='t' || *e=='T'); + + wait_on_abort=0; + if ((e=getenv("GCL_WAIT_ON_ABORT"))) diff --git a/patches/Version_2_6_13pre72 b/patches/Version_2_6_13pre72 new file mode 100644 index 00000000..136954bb --- /dev/null +++ b/patches/Version_2_6_13pre72 @@ -0,0 +1,103 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-81) unstable; urgency=high + . + * Version_2_6_13pre72 + * Fix to ppc64el for acl2 FTBFS bug +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-01-21 + +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h +@@ -1,12 +1,12 @@ + static Sym *toc; + +-/* static int tramp[]={0,0, */ +-/* (((0x3a<<10)|(0x9<<5)|0xc)<<16)|0xfff8,/\*ld r9,-8(r12)*\/ */ +-/* ((0x3a<<10)|(0x9<<5)|0x9)<<16, /\*ld r9,0(r9)*\/ */ +-/* 0x7d2c4b78, /\*mr r12,r9 *\/ */ +-/* 0x7d8903a6, /\*mtctr r12*\/ */ +-/* 0x4e800420 /\*bctrl*\/ */ +-/* }; */ ++static int tramp[]={0,0, ++ (((0x3a<<10)|(0x9<<5)|0xc)<<16)|0xfff8,/*ld r9,-8(r12)*/ ++ ((0x3a<<10)|(0x9<<5)|0x9)<<16, /*ld r9,0(r9)*/ ++ 0x7d2c4b78, /*mr r12,r9 */ ++ 0x7d8903a6, /*mtctr r12*/ ++ 0x4e800420 /*bctrl*/ ++}; + + static int + find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, +@@ -15,41 +15,29 @@ find_special_params(void *v,Shdr *sec1,S + Shdr *sec; + Rela *r; + void *ve; ++ ul *u,j; + + massert((sec=get_section(".rela.dyn",sec1,sece,sn))); + + v+=sec->sh_offset; + ve=v+sec->sh_size; + +- for (r=v;vsh_entsize,r=v) ++ for (j=0,r=v;vsh_entsize,r=v) + if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) +- ds1[ELF_R_SYM(r->r_info)].st_value=*(ul *)r->r_offset; ++ j++; + +- return 0; +- +- +- /* massert((sec=get_section(".rel.dyn",sec1,sece,sn))|| */ +- /* (sec=get_section(".rela.dyn",sec1,sece,sn))); */ ++ massert(u=malloc(j*sizeof(tramp))); + +- /* v+=sec->sh_offset; */ +- /* ve=v+sec->sh_size; */ ++ v=ve-sec->sh_size; ++ for (r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) { ++ memcpy(u,tramp,sizeof(tramp)); ++ *u++=r->r_offset; ++ ds1[ELF_R_SYM(r->r_info)].st_value=(ul)u; ++ u=((void *)(u-1)+sizeof(tramp)); ++ } + +- /* for (j=0,r=v;vsh_entsize,r=v) */ +- /* if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) */ +- /* j++; */ +- +- /* massert(u=malloc(j*sizeof(tramp))); */ +- +- /* v=ve-sec->sh_size; */ +- /* for (r=v;vsh_entsize,r=v) */ +- /* if (ELF_R_TYPE(r->r_info) && !ds1[ELF_R_SYM(r->r_info)].st_value) { */ +- /* memcpy(u,tramp,sizeof(tramp)); */ +- /* *u++=r->r_offset; */ +- /* ds1[ELF_R_SYM(r->r_info)].st_value=(ul)u; */ +- /* u=((void *)(u-1)+sizeof(tramp)); */ +- /* } */ +- +- /* return 0; */ ++ return 0; + + } + diff --git a/patches/Version_2_6_13pre73 b/patches/Version_2_6_13pre73 new file mode 100644 index 00000000..c64ecc45 --- /dev/null +++ b/patches/Version_2_6_13pre73 @@ -0,0 +1,130 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-81) unstable; urgency=high + . + * Version_2_6_13pre72 + * Fix to ppc64el for acl2 FTBFS bug +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-02 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4181,7 +4181,7 @@ case $use in + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; + arm*) +- assert_arg_to_cflags -mlong-calls ++# assert_arg_to_cflags -mlong-calls + assert_arg_to_cflags -fdollars-in-identifiers + assert_arg_to_cflags -g #? + ;; +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -388,7 +388,7 @@ case $use in + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; + arm*) +- assert_arg_to_cflags -mlong-calls ++# assert_arg_to_cflags -mlong-calls + assert_arg_to_cflags -fdollars-in-identifiers + assert_arg_to_cflags -g #? + ;; +--- gcl-2.6.12.orig/h/arm-linux.h ++++ gcl-2.6.12/h/arm-linux.h +@@ -12,5 +12,6 @@ + #define SGC + + #define RELOC_H "elf32_arm_reloc.h" ++#define SPECIAL_RELOC_H "elf32_arm_reloc_special.h" + + #define NEED_STACK_CHK_GUARD +--- gcl-2.6.12.orig/h/elf32_arm_reloc.h ++++ gcl-2.6.12/h/elf32_arm_reloc.h +@@ -53,11 +53,21 @@ + break; + case R_ARM_CALL: + case R_ARM_JUMP24: +- add_vals(where,MASK(24),((long)(s+a-p))>>2); ++ massert(!a); ++ { ++ long x=((long)(s-p))/4; ++ if (abs(x)&(~MASK(23))) { ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++ got[sizeof(tramp)/sizeof(*got)]=s; ++ x=((long)got-p)/4; ++ } ++ add_vals(where,MASK(24),x); ++ } + break; + case R_ARM_ABS32: +- add_val(where,~0L,s+a); ++ add_vals(where,~0L,s+a); + break; + case R_ARM_V4BX: +- add_val(where,~0L,s+a); ++ add_vals(where,~0L,s+a); + break; +--- /dev/null ++++ gcl-2.6.12/h/elf32_arm_reloc_special.h +@@ -0,0 +1,43 @@ ++/* #define R_AARCH64_TRAMP 1 */ ++static int tramp[]={0xe59fc000, /*ldr r12, [pc]*/ /*FIXME? Can this refer to an earlier address?*/ ++ 0xe12fff1c}; /*br r12*/ ++static ul tz=1+sizeof(tramp)/sizeof(ul); ++ ++ ++static int ++find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, ++ const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { ++ ++ return 0; ++ ++} ++ ++static int ++label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { ++ ++ Rel *r; ++ Sym *sym; ++ Shdr *sec; ++ void *v,*ve; ++ ++ for (sym=sym1;symst_size=0; ++ ++ for (*gs=0,sec=sec1;secsh_type==SHT_REL) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_ARM_CALL || ++ ELF_R_TYPE(r->r_info)==R_ARM_JUMP24) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++ if (!sym->st_size) ++ sym->st_size=++*gs; ++ ++ } ++ ++ (*gs)*=tz; ++ ++ return 0; ++ ++} diff --git a/patches/Version_2_6_13pre74 b/patches/Version_2_6_13pre74 new file mode 100644 index 00000000..e8e364fb --- /dev/null +++ b/patches/Version_2_6_13pre74 @@ -0,0 +1,47 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-82) unstable; urgency=high + . + * Version_2_6_13pre73 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-02 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4122,7 +4122,7 @@ $as_echo_n "checking working gprof... " + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +- arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -335,7 +335,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +- arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac diff --git a/patches/Version_2_6_13pre76 b/patches/Version_2_6_13pre76 new file mode 100644 index 00000000..bac042b4 --- /dev/null +++ b/patches/Version_2_6_13pre76 @@ -0,0 +1,446 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-83) unstable; urgency=high + . + * Version_2_6_13pre75 + * FIx acl2 arm builds (Closes: #919477). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/919477 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-05 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -2679,6 +2679,7 @@ case $canonical in + mipsel*linux*) use=mipsel-linux;; + sparc*linux*) use=sparc-linux;; + aarch64*linux*) use=aarch64-linux;; ++ arm*linux*hf) use=armhf-linux;; + arm*linux*) use=arm-linux;; + s390*linux*) use=s390-linux;; + ia64*linux*) use=ia64-linux;; +@@ -4122,11 +4123,12 @@ $as_echo_n "checking working gprof... " + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +-# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++# arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac +- if test "$enableval" != "yes" ; then ++ GP_FLAG="" ++ if test "$enableval" != "yes" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 + $as_echo "disabled" >&6; } + else +@@ -4134,7 +4136,8 @@ $as_echo "disabled" >&6; } + $as_echo "ok" >&6; } + OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg + assert_arg_to_cflags -pg +- CFLAGS=$OLD_CFLAGS ++ GP_FLAG="-pg" ++ CFLAGS=$OLD_CFLAGS + TFPFLAG="" + + $as_echo "#define GCL_GPROF 1" >>confdefs.h +@@ -4180,8 +4183,11 @@ case $use in + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; ++ armhf*) ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? ++ ;; + arm*) +-# assert_arg_to_cflags -mlong-calls + assert_arg_to_cflags -fdollars-in-identifiers + assert_arg_to_cflags -g #? + ;; +@@ -9051,6 +9057,7 @@ LDFLAGS="`echo $LDFLAGS | sed 's,gcl.scr + + LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + ++CFLAGS="$CFLAGS $GP_FLAG" + FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" + + # Work around bug with gcc on ppc -- CM +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -37,6 +37,7 @@ case $canonical in + mipsel*linux*) use=mipsel-linux;; + sparc*linux*) use=sparc-linux;; + aarch64*linux*) use=aarch64-linux;; ++ arm*linux*hf) use=armhf-linux;; + arm*linux*) use=arm-linux;; + s390*linux*) use=s390-linux;; + ia64*linux*) use=ia64-linux;; +@@ -335,17 +336,19 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + sh4*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; +-# arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++# arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible + aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac +- if test "$enableval" != "yes" ; then ++ GP_FLAG="" ++ if test "$enableval" != "yes" ; then + AC_MSG_RESULT([disabled]) + else + AC_MSG_RESULT([ok]) + OLD_CFLAGS=$CFLAGS # Do not run configure tests with -pg + assert_arg_to_cflags -pg +- CFLAGS=$OLD_CFLAGS ++ GP_FLAG="-pg" ++ CFLAGS=$OLD_CFLAGS + TFPFLAG="" + AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) + fi +@@ -387,8 +390,11 @@ case $use in + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; ++ armhf*) ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? ++ ;; + arm*) +-# assert_arg_to_cflags -mlong-calls + assert_arg_to_cflags -fdollars-in-identifiers + assert_arg_to_cflags -g #? + ;; +@@ -2108,6 +2114,7 @@ LDFLAGS="`echo $LDFLAGS | sed 's,gcl.scr + AC_SUBST(LDFLAGS) + LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + AC_SUBST(LIBS) ++CFLAGS="$CFLAGS $GP_FLAG" + FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" + AC_SUBST(FINAL_CFLAGS) + # Work around bug with gcc on ppc -- CM +--- /dev/null ++++ gcl-2.6.12/h/armhf-linux.h +@@ -0,0 +1,17 @@ ++#include "linux.h" ++ ++#ifdef IN_GBC ++#undef MPROTECT_ACTION_FLAGS ++#define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO ++#define GET_FAULT_ADDR(sig,code,sv,a) \ ++ ((siginfo_t *)code)->si_addr ++/* #define GET_FAULT_ADDR(sig,code,sv,a) \ */ ++/* ((void *)(*((char ***)(&code)))[44]) */ ++#endif ++ ++#define SGC ++ ++#define RELOC_H "elf32_armhf_reloc.h" ++#define SPECIAL_RELOC_H "elf32_armhf_reloc_special.h" ++ ++#define NEED_STACK_CHK_GUARD +--- gcl-2.6.12.orig/h/elf32_arm_reloc.h ++++ gcl-2.6.12/h/elf32_arm_reloc.h +@@ -1,44 +1,7 @@ +-#define R_ARM_THM_CALL 10 +-#define R_ARM_CALL 28 +-#define R_ARM_V4BX 40 +-#define R_ARM_THM_MOVW_ABS_NC 47 +-#define R_ARM_THM_MOVW_ABS 48 + #define R_ARM_MOVW_ABS_NC 43 + #define R_ARM_MOVT_ABS 44 +- case R_ARM_THM_JUMP24: +- s+=a; +- if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; +- s-=p+4; /*FIXME maybe drop 4 and add_val below*/ +- s=((long)s>>1); +- massert(!(abs(s)&0xff000000)); +- store_val(where,MASK(11)<<16,(s&0x7ff)<<16); +- store_val(where,MASK(10),s>>11); +- store_val(where,MASK(1)<<(16+11),(~((s>>21&0x1)^(s>>23&0x1)))<<(16+11)); +- store_val(where,MASK(1)<<(16+13),(~((s>>22&0x1)^(s>>23&0x1)))<<(16+13)); +- store_val(where,MASK(1)<<10,(s>>23&0x1)<<10); +- break; +- case R_ARM_THM_CALL: +- s+=a; +- if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; +- s-=p+4; /*FIXME maybe drop 4 and add_val below*/ +- s=((long)s>>1); +- massert(!(abs(s)&0xffc00000)); +- store_val(where,MASK(11),s>>11); +- store_val(where,MASK(11)<<16,(s&0x7ff)<<16); +- break; +- case R_ARM_THM_MOVW_ABS_NC: +- s+=a; +- if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; +- s&=0xffff; +- s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); +- add_vals(where,~0L,s); +- break; +- case R_ARM_THM_MOVW_ABS: +- s+=a; +- s>>=16; +- s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); +- add_vals(where,~0L,s); +- break; ++#define R_ARM_CALL 28 ++#define R_ARM_V4BX 40 + case R_ARM_MOVW_ABS_NC: + s+=a; + s&=0xffff; +@@ -53,21 +16,21 @@ + break; + case R_ARM_CALL: + case R_ARM_JUMP24: +- massert(!a); + { +- long x=((long)(s-p))/4; +- if (abs(x)&(~MASK(23))) { ++ long x=((long)(s+a-p))/4; ++ if (abs(x)&(~MASK(23))) {/*24?*/ + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); ++ /*relocate*/ + got[sizeof(tramp)/sizeof(*got)]=s; + x=((long)got-p)/4; + } + add_vals(where,MASK(24),x); + } + break; +- case R_ARM_ABS32: ++ case R_ARM_V4BX: + add_vals(where,~0L,s+a); + break; +- case R_ARM_V4BX: ++ case R_ARM_ABS32: + add_vals(where,~0L,s+a); + break; +--- gcl-2.6.12.orig/h/elf32_arm_reloc_special.h ++++ gcl-2.6.12/h/elf32_arm_reloc_special.h +@@ -1,9 +1,7 @@ +-/* #define R_AARCH64_TRAMP 1 */ +-static int tramp[]={0xe59fc000, /*ldr r12, [pc]*/ /*FIXME? Can this refer to an earlier address?*/ +- 0xe12fff1c}; /*br r12*/ ++static int tramp[]={0xe59fc000, /*ldr r12, [pc]*/ /*FIXME? Can this refer to an earlier address?*/ ++ 0xe12fff1c}; /*br r12*/ + static ul tz=1+sizeof(tramp)/sizeof(ul); + +- + static int + find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, + const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { +@@ -26,8 +24,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + for (*gs=0,sec=sec1;secsh_type==SHT_REL) + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) +- if (ELF_R_TYPE(r->r_info)==R_ARM_CALL || +- ELF_R_TYPE(r->r_info)==R_ARM_JUMP24) { ++ if ( ++ ELF_R_TYPE(r->r_info)==R_ARM_CALL || ++ ELF_R_TYPE(r->r_info)==R_ARM_JUMP24 ++ ) { + + sym=sym1+ELF_R_SYM(r->r_info); + +--- /dev/null ++++ gcl-2.6.12/h/elf32_armhf_reloc.h +@@ -0,0 +1,71 @@ ++#define R_ARM_THM_CALL 10 ++#define R_ARM_THM_MOVW_ABS_NC 47 ++#define R_ARM_THM_MOVW_ABS 48 ++ case R_ARM_THM_JUMP24: ++ { ++ long x=(long)(s+a-p); ++ if (1||abs(x)&(~MASK(25))) { ++ ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++ ++ r->r_offset=(void *)got-(void *)start; ++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS_NC); ++ relocate(sym1,r,0,start,got,gote); ++ ++ r->r_offset=(void *)(got+1)-(void *)start; ++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS); ++ relocate(sym1,r,0,start,got,gote); ++ ++ x=((long)got-p); ++ } ++ if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) x|=1; ++ x-=4; /*FIXME maybe drop 4 and add_val below*/ ++ x=((long)x>>1); ++ store_val(where,MASK(11)<<16,(x&0x7ff)<<16); ++ store_val(where,MASK(10),x>>11); ++ store_val(where,MASK(1)<<(16+11),(~((x>>21&0x1)^(x>>23&0x1)))<<(16+11)); ++ store_val(where,MASK(1)<<(16+13),(~((x>>22&0x1)^(x>>23&0x1)))<<(16+13)); ++ store_val(where,MASK(1)<<10,(x>>23&0x1)<<10); ++ } ++ break; ++ case R_ARM_THM_CALL: ++ { ++ long x=(long)(s+a-p); ++ if (1||abs(x)&(~MASK(23))) {/*24?*/ ++ got+=(sym->st_size-1)*tz; ++ memcpy(got,tramp,sizeof(tramp)); ++ ++ r->r_offset=(void *)got-(void *)start; ++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS_NC); ++ relocate(sym1,r,0,start,got,gote); ++ ++ r->r_offset=(void *)(got+1)-(void *)start; ++ r->r_info=ELF_R_INFO(ELF_R_SYM(r->r_info),R_ARM_THM_MOVW_ABS); ++ relocate(sym1,r,0,start,got,gote); ++ ++ x=((long)got-p); ++ } ++ if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) x|=1; ++ x-=4; /*FIXME maybe drop 4 and add_val below*/ ++ x=((long)x>>1); ++ store_val(where,MASK(11),x>>11); ++ store_val(where,MASK(11)<<16,(x&0x7ff)<<16); ++ } ++ break; ++ case R_ARM_THM_MOVW_ABS_NC: ++ s+=a; ++ if (ELF_ST_TYPE(sym->st_info)==STT_FUNC) s|=1; ++ s&=0xffff; ++ s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); ++ add_vals(where,~0L,s); ++ break; ++ case R_ARM_THM_MOVW_ABS: ++ s+=a; ++ s>>=16; ++ s=((s>>12)&0xf)|(((s>>11)&0x1)<<10)|((s&0xff)<<16)|(((s>>8)&0x7)<<28); ++ add_vals(where,~0L,s); ++ break; ++ case R_ARM_ABS32: ++ add_vals(where,~0L,s+a); ++ break; +--- /dev/null ++++ gcl-2.6.12/h/elf32_armhf_reloc_special.h +@@ -0,0 +1,85 @@ ++static int tramp[]={0x0c00f240, /*movw r12, #0*/ ++ 0x0c00f2c0, /*movt r12, #0*/ ++ 0xbf004760}; /*bx r12 nop*/ ++static ul tz=sizeof(tramp)/sizeof(ul); ++ ++static ul * ++next_plt_entry(ul *p,ul *pe) { ++ ++ ul l0=0xe5bef000,/*ldr pc,[ip,#]*/ ++ l1=0xe5bcf000;/*ldr pc,[lr,#]*/ ++ ++ for (;psh_addr; ++ pe=(void *)p+psec->sh_size; ++ ++ massert((sec=get_section( ".rel.plt",sec1,sece,sn)) || ++ (sec=get_section(".rela.plt",sec1,sece,sn))); ++ ++ v+=sec->sh_offset; ++ ve=v+sec->sh_size; ++ ++ p=next_plt_entry(p,pe);/*plt0*/ ++ ++ for (r=v;vsh_entsize,r=v,p=next_plt_entry(p,pe)) { ++ if (!ds1[ELF_R_SYM(r->r_info)].st_value) ++ ds1[ELF_R_SYM(r->r_info)].st_value=(ul)p; ++ } ++ ++ massert(p==pe); ++ massert(v==ve); ++ ++ return 0; ++ ++} ++ ++static int ++label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { ++ ++ Rel *r; ++ Sym *sym; ++ Shdr *sec; ++ void *v,*ve; ++ ++ for (sym=sym1;symst_size=0; ++ ++ for (*gs=0,sec=sec1;secsh_type==SHT_REL) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if ( ++#define R_ARM_THM_CALL 10 ++ ELF_R_TYPE(r->r_info)==R_ARM_THM_CALL || ++ ELF_R_TYPE(r->r_info)==R_ARM_THM_JUMP24 ++ ) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++ if (!sym->st_size) ++ sym->st_size=++*gs; ++ ++ } ++ ++ (*gs)*=tz; ++ ++ return 0; ++ ++} +--- gcl-2.6.12.orig/makedefc.in ++++ gcl-2.6.12/makedefc.in +@@ -6,10 +6,6 @@ + # for main link of raw_gcl + LIBS=@LIBS@ + +-#The multi precision library stuff +-MPFILES=$(MPDIR)/@MPI_FILE@ $(MPDIR)/libmport.a +- +- + # root for the installation, eg /usr/local + # This would cause make install to create /usr/local/bin/gcl and + # /usr/local/lib/gcl-2-??/* with some basic files. +--- gcl-2.6.12.orig/o/unexelf.c ++++ gcl-2.6.12/o/unexelf.c +@@ -887,7 +887,7 @@ unexec (char *new_name, char *old_name, + + /* Walk through all section headers, insert the new data2 section right + before the new bss section. */ +- for (n = 1, nn = 1; n < (int) old_file_h->e_shnum; n++, nn++) ++ for (n = 0, nn = 0; n < (int) old_file_h->e_shnum; n++, nn++) + { + caddr_t src; + /* If it is (s)bss section, insert the new data2 section before it. */ diff --git a/patches/Version_2_6_13pre77 b/patches/Version_2_6_13pre77 new file mode 100644 index 00000000..42293a88 --- /dev/null +++ b/patches/Version_2_6_13pre77 @@ -0,0 +1,71 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-83) unstable; urgency=high + . + * Version_2_6_13pre76 + * FIx acl2 arm builds (Closes: #919477). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/919477 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-05 + +--- gcl-2.6.12.orig/h/elf32_arm_reloc.h ++++ gcl-2.6.12/h/elf32_arm_reloc.h +@@ -18,10 +18,10 @@ + case R_ARM_JUMP24: + { + long x=((long)(s+a-p))/4; +- if (abs(x)&(~MASK(23))) {/*24?*/ ++ if (abs(x)&(~MASK(24))) { + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); +- /*relocate*/ ++ /*recurse on relocate?*/ + got[sizeof(tramp)/sizeof(*got)]=s; + x=((long)got-p)/4; + } +@@ -29,8 +29,6 @@ + } + break; + case R_ARM_V4BX: +- add_vals(where,~0L,s+a); +- break; + case R_ARM_ABS32: + add_vals(where,~0L,s+a); + break; +--- gcl-2.6.12.orig/h/elf32_armhf_reloc.h ++++ gcl-2.6.12/h/elf32_armhf_reloc.h +@@ -4,7 +4,7 @@ + case R_ARM_THM_JUMP24: + { + long x=(long)(s+a-p); +- if (1||abs(x)&(~MASK(25))) { ++ if (abs(x)&(~MASK(24))) { + + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); +@@ -32,7 +32,7 @@ + case R_ARM_THM_CALL: + { + long x=(long)(s+a-p); +- if (1||abs(x)&(~MASK(23))) {/*24?*/ ++ if (abs(x)&(~MASK(23))) { + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); + diff --git a/patches/Version_2_6_13pre78 b/patches/Version_2_6_13pre78 new file mode 100644 index 00000000..85136467 --- /dev/null +++ b/patches/Version_2_6_13pre78 @@ -0,0 +1,38 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-83) unstable; urgency=high + . + * Version_2_6_13pre77 + * FIx acl2 arm builds (Closes: #919477). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/919477 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-05 + +--- gcl-2.6.12.orig/h/elf32_arm_reloc.h ++++ gcl-2.6.12/h/elf32_arm_reloc.h +@@ -18,7 +18,7 @@ + case R_ARM_JUMP24: + { + long x=((long)(s+a-p))/4; +- if (abs(x)&(~MASK(24))) { ++ if (abs(x)&(~MASK(23))) { + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); + /*recurse on relocate?*/ diff --git a/patches/Version_2_6_13pre79 b/patches/Version_2_6_13pre79 new file mode 100644 index 00000000..6105d421 --- /dev/null +++ b/patches/Version_2_6_13pre79 @@ -0,0 +1,47 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-83) unstable; urgency=high + . + * Version_2_6_13pre78 + * FIx acl2 arm builds (Closes: #919477). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/919477 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-02-06 + +--- gcl-2.6.12.orig/h/elf32_armhf_reloc.h ++++ gcl-2.6.12/h/elf32_armhf_reloc.h +@@ -4,7 +4,7 @@ + case R_ARM_THM_JUMP24: + { + long x=(long)(s+a-p); +- if (abs(x)&(~MASK(24))) { ++ if (abs(x)&(~MASK(23))) { + + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); +@@ -32,7 +32,7 @@ + case R_ARM_THM_CALL: + { + long x=(long)(s+a-p); +- if (abs(x)&(~MASK(23))) { ++ if (abs(x)&(~MASK(22))) { + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); + diff --git a/patches/Version_2_6_13pre80 b/patches/Version_2_6_13pre80 new file mode 100644 index 00000000..ad89d0de --- /dev/null +++ b/patches/Version_2_6_13pre80 @@ -0,0 +1,111 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-83) unstable; urgency=high + . + * Version_2_6_13pre79 + * Fix acl2 arm builds (Closes: #919477). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/919477 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-03-21 + +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -175,7 +175,7 @@ TS_MEMBER(t0,TS(t1)|TS(t2)|TS(t3)...) + #define TS(s) (1<tm_npage)); +- CEerror("The storage for ~A is exhausted.~%\ +-Currently, ~D pages are allocated.~% \ +-Use ALLOCATE to expand the space.", +- "Continues execution.", +- 2, vs_top[-2], vs_top[-1], Cnil, Cnil); +- +- vs_popp; +- vs_popp; ++ CEerror("Continues execution.", ++ "The storage for ~A is exhausted. ~D pages allocated. Use ALLOCATE to expand the space.", ++ 2, type_name(t), make_fixnum(tm->tm_npage)); + + call_after_gbc_hook(t); + +--- gcl-2.6.12.orig/o/array.c ++++ gcl-2.6.12/o/array.c +@@ -211,14 +211,18 @@ DEFUN_NEW("ASET1", object, fSaset1, SI, + break; + case aet_bit: + i += BV_OFFSET(x); +- AGAIN_BIT: + ASSURE_TYPE(val,t_fixnum); +- {int v = Mfix(val); +- if (v == 0) CLEAR_BITREF(x,i); +- else if (v == 1) SET_BITREF(x,i); +- else {val= fSincorrect_type(val,sLbit); +- goto AGAIN_BIT;} +- break;} ++ switch (Mfix(val)) { ++ case 0: ++ CLEAR_BITREF(x,i); ++ break; ++ case 1: ++ SET_BITREF(x,i); ++ break; ++ default: ++ TYPE_ERROR(val,sLbit); ++ } ++ break; + case aet_fix: + ASSURE_TYPE(val,t_fixnum); + (x->fixa.fixa_self[i]) = Mfix(val); +--- gcl-2.6.12.orig/o/utils.c ++++ gcl-2.6.12/o/utils.c +@@ -169,20 +169,6 @@ Ifuncall_n(object fun,int n,...) { + /* return res; */ + /* } */ + +-object +-Icheck_one_type(object x, enum type t) +-{ if (x->d.t != t) +- { return CEerror("Expected a ~a ","Supply right type",1,type_name(t),Cnil,Cnil,Cnil); +- } +- return x; +-} +- +- +-object +-fSincorrect_type(object val, object type) +-{ return CEerror("Got ~a,Expected a ~a","Supply a new one",1,val,type,Cnil,Cnil); +-} +- + /* static void */ + /* Ineed_in_image(object (*foo) (/\* ??? *\/)) */ + /* {;} */ diff --git a/patches/Version_2_6_13pre81 b/patches/Version_2_6_13pre81 new file mode 100644 index 00000000..63f2a285 --- /dev/null +++ b/patches/Version_2_6_13pre81 @@ -0,0 +1,71 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-84) unstable; urgency=medium + . + * Version_2_6_13pre80 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-03-28 + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -329,7 +329,7 @@ empty_relblock(void) { + void + setup_rb(bool preserve_rb_pointerp) { + +- int lowp=new_rb_start!=rb_start || rb_high(); ++ int lowp=rb_high(); + + update_pool(2*(nrbpage-page(rb_size()))); + rb_start=new_rb_start; +@@ -349,10 +349,13 @@ resize_hole(ufixnum hp,enum type tp,bool + char *start=rb_begin(),*new_start=heap_end+hp*PAGESIZE; + ufixnum size=rb_pointer-start; + +- if (!in_placep && +- ((new_start<=start && startrb_end : ++ new_start+(nrbpage<s.s_dbind != Cnil) +- emsg("Toggling relblock when resizing hole to %lu\n",hp); ++ emsg("[GC Toggling relblock when resizing hole to %lu]\n",hp); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + return resize_hole(hp,tp,in_placep); +@@ -389,7 +392,7 @@ alloc_page(long n) { + d=(available_pages/3)s.s_dbind != Cnil) +- emsg("Hole overrun\n"); ++ emsg("[GC Hole overrun]\n"); + + resize_hole(d+nn,t_relocatable,0); + +@@ -852,7 +855,7 @@ add_pages(struct typemanager *tm,fixnum + + if (rb_high() && m>((rb_start-heap_end)>>PAGEWIDTH)) { + if (sSAnotify_gbcA->s.s_dbind != Cnil) +- emsg("Moving relblock low before expanding relblock pages\n"); ++ emsg("[GC Moving relblock low before expanding relblock pages]\n"); + tm_table[t_relocatable].tm_adjgbccnt--; + GBC(t_relocatable); + } diff --git a/patches/Version_2_6_13pre82 b/patches/Version_2_6_13pre82 new file mode 100644 index 00000000..17a9f6f6 --- /dev/null +++ b/patches/Version_2_6_13pre82 @@ -0,0 +1,40 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-85) unstable; urgency=medium + . + * Version_2_6_13pre81 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-03-28 + +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -349,9 +349,10 @@ resize_hole(ufixnum hp,enum type tp,bool + char *start=rb_begin(),*new_start=heap_end+hp*PAGESIZE; + ufixnum size=rb_pointer-start; + ++#define OVERLAP(c_,t_,s_) ((t_)<(c_)+(s_) && (c_)<(t_)+(s_)) + if (!in_placep && (rb_high() ? +- new_start+size>rb_end : +- new_start+(nrbpage<s.s_dbind != Cnil) diff --git a/patches/Version_2_6_13pre83 b/patches/Version_2_6_13pre83 new file mode 100644 index 00000000..585f44fc --- /dev/null +++ b/patches/Version_2_6_13pre83 @@ -0,0 +1,446 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-85) unstable; urgency=medium + . + * Version_2_6_13pre82 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-04-02 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -6375,7 +6375,7 @@ main () + FILE *f; + if (!(f=fopen("conftest1","w"))) + return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + + ; + return 0; +@@ -6591,7 +6591,7 @@ else + #endif + if (!(f=fopen("conftest1","w"))) + return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + return 0; + } + +@@ -6625,7 +6625,7 @@ else + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + return 0; + } + +@@ -6653,8 +6653,9 @@ $as_echo "no" >&6; } + as_fn_error $? "exiting" "$LINENO" 5 + fi + fi +-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_ADDRESS" >&5 +-$as_echo_n "checking CSTACK_ADDRESS... " >&6; } ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_DIRECTION" >&5 ++$as_echo_n "checking CSTACK_DIRECTION... " >&6; } + if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +@@ -6666,14 +6667,61 @@ else + + #include + #include +- void * +- foo() { ++ ++ unsigned long w; ++ ++ void ++ foo(void) { + int i; +- return (void *)&i; ++ w=(unsigned long)&i; + } + + int + main(int argc,char **argv,char **envp) { ++ void *b; ++ FILE *fp = fopen("conftest1","w"); ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ foo(); ++ fprintf(fp,"%d",((unsigned long) &b) > w ? -1 : 1); ++ fclose(fp); ++ return 0; ++ } ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ cstack_direction=`cat conftest1` ++else ++ cstack_direction=0 ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++ ++cat >>confdefs.h <<_ACEOF ++#define CSTACK_DIRECTION $cstack_direction ++_ACEOF ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_direction" >&5 ++$as_echo "$cstack_direction" >&6; } ++ ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_ADDRESS" >&5 ++$as_echo_n "checking CSTACK_ADDRESS... " >&6; } ++if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++ #include ++ #include ++ int ++ main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); + unsigned long i,j; +@@ -6685,13 +6733,13 @@ else + j<<=$PAGEWIDTH; + j<<=16; + i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i-1); +- fclose(fp); +- return 0; ++ if ($cstack_direction==1) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i-1); ++ fclose(fp); ++ return 0; + } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +@@ -6724,12 +6772,6 @@ else + + #include + #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- + int + main(int argc,char **argv,char **envp) { + void *v ; +@@ -6743,14 +6785,14 @@ else + j<<=$PAGEWIDTH; + j<<=16; + i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +- fprintf(fp,"%d",j); +- fclose(fp); +- return 0; ++ if ($cstack_direction==1) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++ fprintf(fp,"%ld",j); ++ fclose(fp); ++ return 0; + } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +@@ -6854,54 +6896,6 @@ _ACEOF + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_alignment" >&5 + $as_echo "$cstack_alignment" >&6; } + +-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_DIRECTION" >&5 +-$as_echo_n "checking CSTACK_DIRECTION... " >&6; } +-if test "$cross_compiling" = yes; then : +- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +-as_fn_error $? "cannot run test program while cross compiling +-See \`config.log' for more details" "$LINENO" 5; } +-else +- cat confdefs.h - <<_ACEOF >conftest.$ac_ext +-/* end confdefs.h. */ +- +- #include +- #include +- void * +- foo(void) { +- int i; +- return (void *)&i; +- } +- +- int +- main(int argc,char **argv,char **envp) { +- char *b; +- FILE *fp = fopen("conftest1","w"); +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); +- fclose(fp); +- return 0; +- } +-_ACEOF +-if ac_fn_c_try_run "$LINENO"; then : +- cstack_direction=`cat conftest1` +-else +- cstack_direction=0 +-fi +-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ +- conftest.$ac_objext conftest.beam conftest.$ac_ext +-fi +- +- +-cat >>confdefs.h <<_ACEOF +-#define CSTACK_DIRECTION $cstack_direction +-_ACEOF +- +-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_direction" >&5 +-$as_echo "$cstack_direction" >&6; } +- + # Check whether --enable-immfix was given. + if test "${enable_immfix+set}" = set; then : + enableval=$enable_immfix; +@@ -7050,8 +7044,7 @@ int + main () + { + +- void *v; +- unsigned long i,j,k,l,m; ++ unsigned long i,j,k,l; + FILE *fp = fopen("conftest1","w"); + + for (i=2,k=1;i;k=i,i<<=1); +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -1049,7 +1049,7 @@ AC_RUN_IFELSE( + FILE *f; + if (!(f=fopen("conftest1","w"))) + return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + ]])], + [HAVE_SBRK=1;AC_MSG_RESULT([yes])], + AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx]), +@@ -1145,7 +1145,7 @@ if test "$HAVE_SBRK" = "1" ; then + #endif + if (!(f=fopen("conftest1","w"))) + return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + return 0; + } + ]])],[SBRK=`cat conftest1`]) +@@ -1165,7 +1165,7 @@ if test "$HAVE_SBRK" = "1" ; then + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); ++ fprintf(f,"%p",sbrk(0)); + return 0; + } + ]])],[SBRK1=`cat conftest1`]) +@@ -1183,20 +1183,47 @@ if test "$HAVE_SBRK" = "1" ; then + AC_MSG_ERROR([exiting]) + fi + fi +-AC_MSG_CHECKING(CSTACK_ADDRESS) ++ ++AC_MSG_CHECKING(CSTACK_DIRECTION) + AC_RUN_IFELSE( + [AC_LANG_SOURCE( + [[ + #include + #include +- void * +- foo() { ++ ++ unsigned long w; ++ ++ void ++ foo(void) { + int i; +- return (void *)&i; ++ w=(unsigned long)&i; + } + + int + main(int argc,char **argv,char **envp) { ++ void *b; ++ FILE *fp = fopen("conftest1","w"); ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ foo(); ++ fprintf(fp,"%d",((unsigned long) &b) > w ? -1 : 1); ++ fclose(fp); ++ return 0; ++ }]])], ++ [cstack_direction=`cat conftest1`],[cstack_direction=0]) ++AC_DEFINE_UNQUOTED(CSTACK_DIRECTION,$cstack_direction,[whether C stack grows up or down]) ++AC_MSG_RESULT($cstack_direction) ++ ++ ++AC_MSG_CHECKING(CSTACK_ADDRESS) ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ int ++ main(int argc,char **argv,char **envp) { + void *v ; + FILE *fp = fopen("conftest1","w"); + unsigned long i,j; +@@ -1208,13 +1235,13 @@ AC_RUN_IFELSE( + j<<=$PAGEWIDTH; + j<<=16; + i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i-1); +- fclose(fp); +- return 0; ++ if ($cstack_direction==1) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i-1); ++ fclose(fp); ++ return 0; + }]])], + [cstack_address=`cat conftest1`],[cstack_address=0]) + AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address,[starting C stack address]) +@@ -1226,12 +1253,6 @@ AC_RUN_IFELSE( + [[ + #include + #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- + int + main(int argc,char **argv,char **envp) { + void *v ; +@@ -1245,14 +1266,14 @@ AC_RUN_IFELSE( + j<<=$PAGEWIDTH; + j<<=16; + i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +- fprintf(fp,"%d",j); +- fclose(fp); +- return 0; ++ if ($cstack_direction==1) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++ fprintf(fp,"%ld",j); ++ fclose(fp); ++ return 0; + }]])], + [cstack_bits=`cat conftest1`],[cstack_bits=0]) + AC_DEFINE_UNQUOTED(CSTACK_BITS,$cstack_bits,[log starting C stack address]) +@@ -1302,33 +1323,6 @@ AC_RUN_IFELSE( + AC_DEFINE_UNQUOTED(CSTACK_ALIGNMENT,$cstack_alignment,[C stack alignment]) + AC_MSG_RESULT($cstack_alignment) + +-AC_MSG_CHECKING(CSTACK_DIRECTION) +-AC_RUN_IFELSE( +- [AC_LANG_SOURCE( +- [[ +- #include +- #include +- void * +- foo(void) { +- int i; +- return (void *)&i; +- } +- +- int +- main(int argc,char **argv,char **envp) { +- char *b; +- FILE *fp = fopen("conftest1","w"); +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); +- fclose(fp); +- return 0; +- }]])], +- [cstack_direction=`cat conftest1`],[cstack_direction=0]) +-AC_DEFINE_UNQUOTED(CSTACK_DIRECTION,$cstack_direction,[whether C stack grows up or down]) +-AC_MSG_RESULT($cstack_direction) +- + AC_ARG_ENABLE([immfix],[ --enable-immfix will enable an immediate fixnum table above the C stack]) + + AC_ARG_ENABLE([fastimmfix],[ --enable-fastimmfix=XXXX will reject low immediate fixnums unless 2^XXX can be attained],,[enable_fastimmfix=64]) +@@ -1429,8 +1423,7 @@ AC_RUN_IFELSE( + #include + ]], + [[ +- void *v; +- unsigned long i,j,k,l,m; ++ unsigned long i,j,k,l; + FILE *fp = fopen("conftest1","w"); + + for (i=2,k=1;i;k=i,i<<=1); +--- gcl-2.6.12.orig/h/unrandomize.h ++++ gcl-2.6.12/h/unrandomize.h +@@ -14,7 +14,7 @@ + long pers = personality(READ_IMPLIES_EXEC|personality(0xffffffffUL)); + long flag = ADDR_NO_RANDOMIZE; + +- if (sizeof(long)==4) flag|=ADDR_LIMIT_3GB|ADDR_COMPAT_LAYOUT; ++ if (sizeof(long)==4) flag|=ADDR_LIMIT_3GB/* |ADDR_COMPAT_LAYOUT */; + + if (pers==-1) {printf("personality failure %d\n",errno);exit(-1);} + if ((pers & flag)!=flag && !getenv("GCL_UNRANDOMIZE")) { diff --git a/patches/Version_2_6_13pre84 b/patches/Version_2_6_13pre84 new file mode 100644 index 00000000..ce8c974f --- /dev/null +++ b/patches/Version_2_6_13pre84 @@ -0,0 +1,45 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-86) unstable; urgency=medium + . + * Version_2_6_13pre83 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-04-06 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4121,6 +4121,7 @@ $as_echo_n "checking working gprof... " + powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; ++ m68k*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; + # arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -334,6 +334,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; + s390*) enableval="no";;#mcount smashes float args in make_shortfloat 20180313 + sh4*) enableval="no";; ++ m68k*) enableval="no";; + ia64*) enableval="no";; + hppa*) enableval="no";; + # arm*) if echo $canonical |grep -q hf$; then enableval="no"; fi;;#FIXME CALL and JUMP24 veneers needed for thumb 20190201 #FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible diff --git a/patches/Version_2_6_13pre85 b/patches/Version_2_6_13pre85 new file mode 100644 index 00000000..8f38b607 --- /dev/null +++ b/patches/Version_2_6_13pre85 @@ -0,0 +1,123 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-88) unstable; urgency=medium + . + * Source only upload +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-12-07 + +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc.h +@@ -1,9 +1,25 @@ ++#define R_PPC64_PLTSEQ 119 /*FIXME not in elf.h*/ ++#define R_PPC64_PLTCALL 120 ++ + #define ha(x_) ((((x_) >> 16) + (((x_) & 0x8000) ? 1 : 0)) & 0xffff) + #define lo(x_) ((x_) & 0xffff) + + case R_PPC64_REL16_HA: + store_val(where,MASK(16),ha(s+a-p)); + break; ++ case R_PPC64_PLT16_HA: ++ gote=got+sym->st_size-1; ++ *gote=s+a; ++ store_val(where,MASK(16),ha((ul)gote-toc->st_value)); ++ break; ++ case R_PPC64_PLT16_LO_DS: ++ gote=got+sym->st_size-1; ++ *gote=s+a; ++ store_val(where,MASK(16),lo((ul)gote-toc->st_value));/*>>2*/ ++ break; ++ case R_PPC64_PLTSEQ: ++ case R_PPC64_PLTCALL: ++ break; + case R_PPC64_TOC16_HA: + store_val(where,MASK(16),ha(s+a-toc->st_value)); + break; +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h +@@ -9,16 +9,12 @@ static int tramp[]={0,0, + }; + + static int +-find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, +- const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { +- +- Shdr *sec; ++load_trampolines(void *v,Shdr *sec,Sym *ds1) { ++ + Rela *r; + void *ve; + ul *u,j; + +- massert((sec=get_section(".rela.dyn",sec1,sece,sn))); +- + v+=sec->sh_offset; + ve=v+sec->sh_size; + +@@ -42,8 +38,25 @@ find_special_params(void *v,Shdr *sec1,S + } + + static int ++find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn, ++ const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) { ++ ++ Shdr *sec; ++ ++ massert((sec=get_section(".rela.dyn",sec1,sece,sn))); ++ massert(!load_trampolines(v,sec,ds1)); ++ if ((sec=get_section(".rela.plt",sec1,sece,sn))) ++ massert(!load_trampolines(v,sec,ds1)); ++ ++ return 0; ++ ++} ++ ++static int + label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) { + ++ Rela *r; ++ void *v,*ve; + Shdr *sec; + Sym *sym; + +@@ -58,6 +71,22 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + } + } + ++ for (sym=sym1;symst_size=0; ++ ++ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_PPC64_PLT16_HA|| ++ ELF_R_TYPE(r->r_info)==R_PPC64_PLT16_LO_DS) { ++ ++ sym=sym1+ELF_R_SYM(r->r_info); ++ ++ if (!sym->st_size) ++ sym->st_size=++*gs; ++ ++ } ++ + return 0; + + } diff --git a/patches/Version_2_6_13pre86 b/patches/Version_2_6_13pre86 new file mode 100644 index 00000000..9bc68f2a --- /dev/null +++ b/patches/Version_2_6_13pre86 @@ -0,0 +1,45 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-88) unstable; urgency=medium + . + * Source only upload +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-12-07 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4194,6 +4194,7 @@ case $use in + ;; + powerpc*) + assert_arg_to_cflags -mlongcall ++ if test "$host_cpu" != "powerpc64le" ; then assert_arg_to_cflags -mno-pltseq; fi + ;; + esac;; + esac +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -401,6 +401,7 @@ case $use in + ;; + powerpc*) + assert_arg_to_cflags -mlongcall ++ if test "$host_cpu" != "powerpc64le" ; then assert_arg_to_cflags -mno-pltseq; fi + ;; + esac;; + esac diff --git a/patches/Version_2_6_13pre87 b/patches/Version_2_6_13pre87 new file mode 100644 index 00000000..b38d6b45 --- /dev/null +++ b/patches/Version_2_6_13pre87 @@ -0,0 +1,89 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-89) unstable; urgency=medium + . + * Bug fix: "gcl - FTBFS on ppc64el - invalid relocation type 31", thanks + to thierry.fauck@fr.ibm.com; (Closes: #942312). + * Bug fix: "FTBFS on ppc64el", thanks to Ivo De Decker (Closes: + #944651). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/942312 +Bug-Debian: https://bugs.debian.org/944651 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-12-08 + +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc.h +@@ -10,32 +10,38 @@ + case R_PPC64_PLT16_HA: + gote=got+sym->st_size-1; + *gote=s+a; ++ massert(toc); + store_val(where,MASK(16),ha((ul)gote-toc->st_value)); + break; + case R_PPC64_PLT16_LO_DS: + gote=got+sym->st_size-1; + *gote=s+a; ++ massert(toc); + store_val(where,MASK(16),lo((ul)gote-toc->st_value));/*>>2*/ + break; + case R_PPC64_PLTSEQ: + case R_PPC64_PLTCALL: + break; + case R_PPC64_TOC16_HA: ++ massert(toc); + store_val(where,MASK(16),ha(s+a-toc->st_value)); + break; + case R_PPC64_TOC16_LO_DS: ++ massert(toc); + store_val(where,MASK(16),lo(s+a-toc->st_value));/*>>2*/ + break; + case R_PPC64_REL16_LO: + store_val(where,MASK(16),lo(s+a-p)); + break; + case R_PPC64_TOC16_LO: ++ massert(toc); + store_val(where,MASK(16),lo(s+a-toc->st_value)); + break; + case R_PPC64_ADDR64: + store_val(where,~0L,(s+a)); + break; + case R_PPC64_TOC: ++ massert(toc); + store_val(where,~0L,toc->st_value); + break; + case R_PPC64_REL32: +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h +@@ -60,13 +60,12 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + Shdr *sec; + Sym *sym; + +- massert(sec=get_section(".toc",sec1,sece,sn)); +- +- for (sym=sym1;symst_name; + if (!strcmp(s,".TOC.") || !strcmp(s,".toc.")) { + toc=sym; + toc->st_info=ELF_ST_INFO(STB_LOCAL,ELF_ST_TYPE(sym->st_info)); ++ massert((sec=get_section(".bss",sec1,sece,sn))); + toc->st_shndx=sec-sec1; + } + } diff --git a/patches/Version_2_6_13pre88 b/patches/Version_2_6_13pre88 new file mode 100644 index 00000000..5701ceb6 --- /dev/null +++ b/patches/Version_2_6_13pre88 @@ -0,0 +1,151 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-90) unstable; urgency=medium + . + * Version_2_6_13pre87 + * latest standards +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-12-18 + +--- gcl-2.6.12.orig/h/pool.h ++++ gcl-2.6.12/h/pool.h +@@ -20,9 +20,8 @@ static struct pool { + ufixnum s; + } *Pool; + +-static struct flock pl,*plp=&pl; +- +-static const char *gcl_pool="/tmp/gcl_pool"; ++static struct flock f,pl,*plp=&pl; ++static char gcl_pool[PATH_MAX]; + + static int + set_lock(void) { +@@ -66,8 +65,8 @@ open_pool(void) { + + if (pool==-1) { + +- struct flock f; +- ++ massert(!home_namestring1("~",1,FN1,sizeof(FN1))); ++ massert(snprintf(gcl_pool,sizeof(gcl_pool),"%sgcl_pool",FN1)>=0); + massert((pool=open(gcl_pool,O_CREAT|O_RDWR,0644))!=-1); + massert(!ftruncate(pool,sizeof(struct pool))); + massert((Pool=mmap(NULL,sizeof(struct pool),PROT_READ|PROT_WRITE,MAP_SHARED,pool,0))!=(void *)-1); +@@ -111,6 +110,9 @@ close_pool(void) { + + #ifndef NO_FILE_LOCKING + if (pool!=-1) { ++ f.l_type=F_WRLCK; ++ if (!fcntl(pool,F_SETLK,&f)) ++ massert(!unlink(gcl_pool)); + register_pool(-1); + massert(!close(pool)); + massert(!munmap(Pool,sizeof(struct pool))); +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1971,3 +1971,6 @@ travel_find_sharing(object,object); + + object + new_cfdata(void); ++ ++int ++home_namestring1(const char *,int,char *,int); +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -95,16 +95,20 @@ DEFUN_NEW("UID-TO-NAME",object,fSuid_to_ + #endif + } + +-DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { ++int ++home_namestring1(const char *n,int s,char *o,int so) { + +-#ifndef __MINGW32__ ++ #ifndef __MINGW32__ + struct passwd *pwent,pw; + long r; + ++ massert(s>0); ++ massert(*n=='~'); ++ + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); + massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ + +- if (nm->st.st_fillp==1) ++ if (s==1) + + if ((pw.pw_dir=getenv("HOME"))) + pwent=&pw; +@@ -113,26 +117,44 @@ DEFUN_NEW("HOME-NAMESTRING",object,fShom + + else { + +- massert(nm->st.st_fillpst.st_self+1,nm->st.st_fillp-1); +- FN2[nm->st.st_fillp-1]=0; ++ massert(spw_dir))+2pw_dir,r); +- FN3[r]='/'; +- FN3[r+1]=0; +- RETURN1(make_simple_string(FN3)); ++ massert((r=strlen(pwent->pw_dir))+2pw_dir,r); ++ o[r]='/'; ++ o[r+1]=0; ++ return 0; + #else +- massert(snprintf(FN1,sizeof(FN1)-1,"%s%s",getenv("SystemDrive"),getenv("HOMEPATH"))>=0); +- RETURN1(make_simple_string(FN1)); ++ massert(snprintf(o,so-1,"%s%s",getenv("SystemDrive"),getenv("HOMEPATH"))>=0); ++ return 0; + #endif + + } + ++ ++DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { ++ ++ check_type_string(&nm); ++ ++ massert(!home_namestring1(nm->st.st_self,nm->st.st_fillp,FN1,sizeof(FN1))); ++ RETURN1(make_simple_string(FN1)); ++ ++} ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fShome_namestring(object x) { ++ return FFN(fShome_namestring)(x); ++} ++#endif ++ ++ ++ + #define FILE_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISREG(b_.st_mode) + #define DIR_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISDIR(b_.st_mode) + diff --git a/patches/Version_2_6_13pre89 b/patches/Version_2_6_13pre89 new file mode 100644 index 00000000..dec85967 --- /dev/null +++ b/patches/Version_2_6_13pre89 @@ -0,0 +1,277 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-91) unstable; urgency=medium + . + * Version_2_6_13pre88 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2019-12-30 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -57,28 +57,19 @@ + + + ;; Let the user write dump c-file etc to /dev/null. +-(defun get-output-pathname (file ext name &optional (dir (pathname-directory *default-pathname-defaults*)) ++(defun get-output-pathname (file ext name &optional ++ (dir (pathname-directory *default-pathname-defaults*)) + (device (pathname-device *default-pathname-defaults*))) +- (cond +- ((equal file "/dev/null") (pathname file)) ++ (cond ((equal file "/dev/null") (pathname file)) + #+aix3 + ((and (equal name "float") + (equal ext "h")) + (get-output-pathname file ext "Float" )) +- (t +- (make-pathname :device (or (and (not (null file)) +- (not (eq file t)) +- (pathname-device file)) +- device) +- :directory (or (and (not (null file)) +- (not (eq file t)) +- (pathname-directory file)) +- dir) +- :name (or (and (not (null file)) +- (not (eq file t)) +- (pathname-name file)) +- name) +- :type ext)))) ++ ((let ((lf (and file (not (eq file t))))) ++ (let ((device (if lf (pathname-device file) device)) ++ (dir (if lf (pathname-directory file) dir)) ++ (name (if lf (pathname-name file) name))) ++ (make-pathname :device device :directory dir :name name :type ext)))))) + + (defun safe-system (string) + (multiple-value-bind +@@ -109,15 +100,7 @@ + ;; will be performed for separate chunks of the lisp files. + (defvar *split-files* nil) ;; if + +-(defun check-end (form eof) +- (cond ((eq form eof) +- (setf (third *split-files*) nil)) +- ((> (file-position *compiler-input*) +- (car *split-files*)) +- (setf (third *split-files*)(file-position *compiler-input*))))) +- +- +-(defun compile-file (&rest args ++(defun compile-file (filename &rest args + &aux (*print-pretty* nil) + (*package* *package*) (*split-files* *split-files*) + (*PRINT-CIRCLE* NIL) +@@ -131,17 +114,17 @@ + (*PRINT-BASE* 10) + (*PRINT-ESCAPE* T) + (section-length *split-files*) +- tem) ++ tem warnings failures ++ (filename (pathname filename)) ++ (*compile-file-pathname* (merge-pathnames filename #p".lsp")) ++ (*compile-file-truename* (truename *compile-file-pathname*))) + (loop + (compiler::init-env) +- (setq tem (apply 'compiler::compile-file1 args)) +- (cond ((atom *split-files*)(return tem)) +- ((and (consp *split-files*) +- (null (third *split-files*))) +- (let ((gaz (let ((*DEFAULT-PATHNAME-DEFAULTS* (car args))) +- (gazonk-name))) +- (*readtable* (si::standard-readtable))) +- (setq gaz (get-output-pathname gaz "lsp" (car args))) ++ (setq tem (apply 'compile-file1 filename args)) ++ (cond ((atom *split-files*) ++ (return (values (when tem (truename tem)) warnings failures))) ++ ((null (third *split-files*)) ++ (let ((gaz (gazonk-name))(*readtable* (si::standard-readtable))) + (with-open-file (st gaz :direction :output) + (print + `(eval-when (load eval) +@@ -149,16 +132,15 @@ + (load (merge-pathnames v si::*load-pathname*)))) + st)) + (setq *split-files* nil) +- (or (member :output-file args) +- (setq args (append args (list :output-file (car args))))) + (return +- (prog1 (apply 'compile-file gaz (cdr args)) +- (unless *keep-gaz* (mdelete-file gaz)))) +- )) +- (t nil)) +- (if (consp *split-files*) +- (setf (car *split-files*) (+ (third *split-files*) section-length))) +- )) ++ (let ((tem (apply 'compile-file gaz ++ (append args ++ (unless (member :output-file args) ++ (list :output-file ++ (get-output-pathname filename "o" nil nil nil))))))) ++ (unless *keep-gaz* (mdelete-file gaz)) ++ (values (when tem (truename tem)) warnings failures))))) ++ ((setf (car *split-files*) (+ (third *split-files*) section-length)))))) + + + (defun compile-file1 (input-pathname +@@ -172,13 +154,14 @@ + (prof-p *default-prof-p*) + (print nil) + (load nil) +- &aux (*standard-output* *standard-output*) +- (*prof-p* prof-p) ++ &aux ++ (*standard-output* *standard-output*) ++ (*prof-p* prof-p) ++ (output-file (pathname output-file)) + (*error-output* *error-output*) + (*compiler-in-use* *compiler-in-use*) + (*c-debug* c-debug) + (*compile-print* (or print *compile-print*)) +- (*package* *package*) + (*DEFAULT-PATHNAME-DEFAULTS* #p"") + (*data* (list nil)) + *init-name* +@@ -211,41 +194,30 @@ Cannot compile ~a.~%" + (*compiler-input* (merge-pathnames input-pathname #p".lsp")) + + +- (cond ((numberp *split-files*) +- (if (< (file-length *compiler-input*) *split-files*) +- (setq *split-files* nil) +- (setq *split-files* (list *split-files* nil 0 nil))))) ++ (when (numberp *split-files*) ++ (setq *split-files* (unless (< (file-length *compiler-input*) *split-files*) (list *split-files* nil 0 nil)))) + +- (cond ((consp *split-files*) +- (file-position *compiler-input* (third *split-files*)) +- (setq output-file +- (make-pathname :directory (pathname-directory output-file) +- :name (format nil "~a~a" (length (second *split-files*)) (pathname-name (pathname output-file))) +- :type "o")) +- +- (push (pathname-name output-file) (second *split-files*)))) ++ (when (consp *split-files*) ++ (file-position *compiler-input* (third *split-files*)) ++ (setq output-file ++ (make-pathname :directory (pathname-directory output-file) ++ :name (format nil "~a~a" ++ (pathname-name output-file) ++ (length (second *split-files*))) ++ :type "o"))) + + +- (let* ((eof (cons nil nil)) +- (dir (or (and (not (null output-file)) +- (pathname-directory output-file)) +- (pathname-directory input-pathname))) +- (name (or (and (not (null output-file)) +- (pathname-name output-file)) +- (pathname-name input-pathname))) +- (device (or (and (not (null output-file)) +- (pathname-device output-file)) +- (pathname-device input-pathname))) +- (typ (or (and (not (null output-file)) +- (pathname-type output-file)) +- "o")) +- +- (o-pathname (get-output-pathname o-file typ name dir device)) +- (c-pathname (get-output-pathname c-file "c" name dir device)) +- (h-pathname (get-output-pathname h-file "h" name dir device)) +- (data-pathname (get-output-pathname data-file "data" name dir device))) ++ (let* ((eof (cons nil nil)) ++ (dir (pathname-directory (or output-file input-pathname))) ++ (name (pathname-name (or output-file input-pathname))) ++ (device (pathname-device (or output-file input-pathname))) ++ (typ (pathname-type (or output-file #p".o"))) ++ (o-pathname (get-output-pathname o-file typ name dir device)) ++ (c-pathname (get-output-pathname c-file "c" name dir device)) ++ (h-pathname (get-output-pathname h-file "h" name dir device)) ++ (data-pathname (get-output-pathname data-file "data" name dir device))) + +- (declare (special dir name )) ++ (declare (special dir name)) + + (init-env) + +@@ -278,21 +250,32 @@ Cannot compile ~a.~%" + (setq prev nil)) + + ;; t1expr the package ops again.. +- (if (consp *split-files*) +- (dolist (v (fourth *split-files*)) (t1expr v))) ++ (when (consp *split-files*) ++ (dolist (v (fourth *split-files*)) (t1expr v))) ++ + (unwind-protect + (do ((form (read *compiler-input* nil eof)(read *compiler-input* nil eof)) +- (load-flag (if *eval-when-defaults* (member 'load *eval-when-defaults*) t))) ++ (load-flag (if *eval-when-defaults* ++ (or (member 'load *eval-when-defaults*) ++ (member :load-toplevel *eval-when-defaults*)) ++ t))) + (nil) +- (cond +- ((eq form eof)) +- (load-flag (t1expr form)) +- ((maybe-eval nil form))) +- (cond +- ((and *split-files* (check-end form eof)) +- (setf (fourth *split-files*) nil);(reverse (third *data*)) ;FIXME check this +- (return nil)) +- ((eq form eof) (return nil)))) ++ ++ (unless (eq form eof) ++ (if load-flag ++ (t1expr form) ++ (maybe-eval nil form))) ++ ++ (when (or (eq form eof) ++ (when *split-files* ++ (> (file-position *compiler-input*) (car *split-files*)))) ++ ++ (when *split-files* ++ (push (pathname-name output-file) (second *split-files*)) ++ (setf (third *split-files*) (unless (eq form eof) (file-position *compiler-input*))) ++ (setf (fourth *split-files*) nil));(reverse (third *data*)) ;FIXME check this ++ ++ (return nil))) + + (when prev (set-dispatch-macro-character #\# #\, prev rtb))))) + +@@ -331,7 +314,7 @@ Cannot compile ~a.~%" + (unless c-file (mdelete-file c-pathname)) + (unless h-file (mdelete-file h-pathname)) + (unless (or data-file #+ld-not-accept-data t system-p) (mdelete-file data-pathname)) +- o-pathname) ++ (when o-file o-pathname)) + + (progn + (when (probe-file c-pathname) (mdelete-file c-pathname)) +@@ -339,8 +322,7 @@ Cannot compile ~a.~%" + (when (probe-file data-pathname) (mdelete-file data-pathname)) + (format t "~&No FASL generated.~%") + (setq *error-p* t) +- (values) +- )))))) ++ (values)))))) + + (defun gazonk-name () + (dotimes (i 1000) diff --git a/patches/Version_2_6_13pre8a b/patches/Version_2_6_13pre8a new file mode 100644 index 00000000..1031df65 --- /dev/null +++ b/patches/Version_2_6_13pre8a @@ -0,0 +1,1359 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-8) unstable; urgency=medium + . + * Version_2_6_13pre7 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/gcl-tk/comm.c ++++ gcl-2.6.12/gcl-tk/comm.c +@@ -66,7 +66,7 @@ fScheck_fd_for_input(fixnum fd,fixnum ti + + + struct connection_state * +-setup_connection_state(fd) ++setup_connection_state(int fd) + { struct connection_state * res; + res = (void *)malloc(sizeof(struct connection_state)); + bzero(res,sizeof(struct connection_state)); +--- gcl-2.6.12.orig/gcl-tk/guis.h ++++ gcl-2.6.12/gcl-tk/guis.h +@@ -4,6 +4,10 @@ + #include + + #define NO_PRELINK_UNEXEC_DIVERSION ++#define IMMNUM_H ++#define GMP_WRAPPERS_H ++#define ERROR_H ++ + #include "include.h" + + #ifdef NeXT +--- gcl-2.6.12.orig/gmp4/mpn/x86_64/k8/redc_1.asm ++++ gcl-2.6.12/gmp4/mpn/x86_64/k8/redc_1.asm +@@ -114,7 +114,7 @@ ifdef(`PIC',` + + JUMPTABSECT + ALIGN(8) +-L(tab): JMPENT( L(0m4), L(tab)) ++L(tab): JMPENT( L(0), L(tab)) + JMPENT( L(1), L(tab)) + JMPENT( L(2), L(tab)) + JMPENT( L(3), L(tab)) +@@ -397,6 +397,7 @@ L(le1): add %r10, (up) + + + ALIGN(16) ++L(0): + L(0m4): + L(lo0): mov (mp,nneg,8), %rax + mov nneg, i +--- gcl-2.6.12.orig/h/att_ext.h ++++ gcl-2.6.12/h/att_ext.h +@@ -29,7 +29,7 @@ void *malloc(size_t); + void *realloc(void *,size_t); + /* void * memalign(size_t,size_t); */ + void *alloc_contblock(size_t); +-inline void *alloc_relblock(size_t); ++void *alloc_relblock(size_t); + /* object fSallocate_contiguous_pages(); */ + /* object fSallocate_relocatable_pages(); */ + +@@ -291,9 +291,7 @@ EXTER object sSAsystem_directoryA; + #ifdef UNIX + EXTER char *kcl_self; + #endif +-#if !defined(IN_MAIN) || !defined(ATT) + EXTER bool raw_image; +-#endif + char *merge_system_directory(); + + +--- gcl-2.6.12.orig/h/cmpincl1.h ++++ gcl-2.6.12/h/cmpincl1.h +@@ -1,2 +1 @@ +-#define EXTER extern + #define CMPINCLUDE +--- gcl-2.6.12.orig/h/compbas.h ++++ gcl-2.6.12/h/compbas.h +@@ -1,2 +1,12 @@ + #include + #define _VA_LIST_DEFINED ++#ifndef EXTER ++#define EXTER extern ++#endif ++#ifndef INLINE ++#if defined(__GNUC__) && __GNUC__ <= 4 ++#define INLINE extern inline ++#else ++#define INLINE inline ++#endif ++#endif +--- gcl-2.6.12.orig/h/error.h ++++ gcl-2.6.12/h/error.h +@@ -1,4 +1,7 @@ +-#define Icall_error_handler(a_,b_,c_,d_...) \ ++#ifndef ERROR_H ++#define ERROR_H ++ ++#define Icall_error_handler(a_,b_,c_,d_...) \ + Icall_gen_error_handler(Cnil,null_string,a_,b_,c_,##d_) + #define Icall_continue_error_handler(a_,b_,c_,d_,e_...) \ + Icall_gen_error_handler(Ct,a_,b_,c_,d_,##e_) +@@ -8,12 +11,8 @@ extern enum type t_vtype; + extern int vtypep_fn(object); + extern void Check_type(object *,int (*)(object),object); + ++#define PFN(a_) INLINE int Join(a_,_fn)(object x) {return a_(x);} + +-#ifdef IN_MAIN +-#define PFN(a_) int Join(a_,_fn)(object x) {return a_(x);} +-#else +-#define PFN(a_) extern int Join(a_,_fn)(object x); +-#endif + PFN(integerp) + PFN(non_negative_integerp) + PFN(rationalp) +@@ -201,3 +200,4 @@ object ihs_top_function_name(ihs_ptr h); + abort();\ + }) + ++#endif /*ERROR_H*/ +--- gcl-2.6.12.orig/h/gmp_wrappers.h ++++ gcl-2.6.12/h/gmp_wrappers.h +@@ -1,12 +1,8 @@ +-#ifndef GMP_EXTERN +-#define GMP_EXTERN extern +-#endif +-#ifndef GMP_EXTERN_INLINE +-#define GMP_EXTERN_INLINE GMP_EXTERN __inline__ +-#endif ++#ifndef GMP_WRAPPERS_H ++#define GMP_WRAPPERS_H + +-GMP_EXTERN jmp_buf gmp_jmp; +-GMP_EXTERN int jmp_gmp,gmp_relocatable; ++EXTER jmp_buf gmp_jmp; ++EXTER int jmp_gmp,gmp_relocatable; + + #define join(a_,b_) a_ ## b_ + #define Join(a_,b_) join(a_,b_) +@@ -95,7 +91,7 @@ GMP_EXTERN int jmp_gmp,gmp_relocatable; + set to -1 otherwise. 20040815 CM*/ + + #define MEM_GMP_CALL(n_,rt_,a_,s_,b_...) \ +- GMP_EXTERN_INLINE Join(RF_,rt_) Join(m,a_)(Join(P,n_)(b_)) { \ ++ INLINE Join(RF_,rt_) Join(m,a_)(Join(P,n_)(b_)) { \ + int j;\ + Join(RD_,rt_);\ + if (gmp_relocatable) {\ +@@ -195,3 +191,5 @@ MEM_GMP_CALL(2,size_t,mpz_sizeinbase,0,m + /*#define __gmpz_realloc m__gmpz_realloc*/ + #define __gmpz_size m__gmpz_size + #define __gmpz_sizeinbase m__gmpz_sizeinbase ++ ++#endif /*GMP_WRAPPERS_H*/ +--- gcl-2.6.12.orig/h/immnum.h ++++ gcl-2.6.12/h/immnum.h +@@ -17,10 +17,10 @@ + #define iif2(x,y) is_imm_fixnum2(x,y) + + +-EXTER inline fixnum ++INLINE fixnum + lnabs(fixnum x) {return x<0 ? ~x : x;} + +-EXTER inline char ++INLINE char + clz(ufixnum x) { + #ifdef HAVE_CLZL + return x ? __builtin_clzl(x) : sizeof(x)*8; +@@ -29,7 +29,7 @@ clz(ufixnum x) { + #endif + } + +-EXTER inline char ++INLINE char + ctz(ufixnum x) { + #ifdef HAVE_CTZL + return __builtin_ctzl(x);/*x ? __builtin_clzl(x) : sizeof(x)*8;*/ +@@ -38,10 +38,10 @@ ctz(ufixnum x) { + #endif + } + +-EXTER inline char ++INLINE char + fixnum_length(fixnum x) {return sizeof(x)*8-clz(lnabs(x));} + +-EXTER inline object ++INLINE object + immnum_length(object x) {return iif(x) ? mif(fixnum_length(fif(x))) : integer_length(x);} + + +@@ -57,7 +57,7 @@ immnum_length(object x) {return iif(x) ? + #define POPD 0x3F + #endif + +-EXTER inline char ++INLINE char + fixnum_popcount(ufixnum x) { + x-=POPA&(x>>1); + x=(x&POPB)+((x>>2)&POPB); +@@ -70,33 +70,33 @@ fixnum_popcount(ufixnum x) { + return x&POPD; + } + +-EXTER inline char ++INLINE char + /* fixnum_count(fixnum x) {return __builtin_popcountl(lnabs(x));} */ + fixnum_count(fixnum x) {return fixnum_popcount(lnabs(x));} + +-EXTER inline object ++INLINE object + immnum_count(object x) {return iif(x) ? mif(fixnum_count(fif(x))) : integer_count(x);} + + /*bs=sizeof(long)*8; + lb=bs-clz(labs(x));|x*y|=|x|*|y|<2^(lbx+lby)<2^(bs-1); + 0 bounded by 2^0, +-1 by 2^1,mpf by 2^(bs-1), which is sign bit + protect labs from most negative fix, here all immfix ok*/ +-EXTER inline bool ++INLINE bool + fixnum_mul_safe_abs(fixnum x,fixnum y) {return clz(x)+clz(y)>sizeof(x)*8+1;} +-EXTER inline object ++INLINE object + safe_mul_abs(fixnum x,fixnum y) {return fixnum_mul_safe_abs(x,y) ? make_fixnum(x*y) : fixnum_times(x,y);} +-EXTER inline bool ++INLINE bool + fixnum_mul_safe(fixnum x,fixnum y) {return fixnum_mul_safe_abs(labs(x),labs(y));} +-EXTER inline object ++INLINE object + safe_mul(fixnum x,fixnum y) {return fixnum_mul_safe(x,y) ? make_fixnum(x*y) : fixnum_times(x,y);} +-EXTER inline object ++INLINE object + immnum_times(object x,object y) {return iif2(x,y) ? safe_mul(fif(x),fif(y)) : number_times(x,y);} + +-EXTER inline object ++INLINE object + immnum_plus(object x,object y) {return iif2(x,y) ? make_fixnum(fif(x)+fif(y)) : number_plus(x,y);} +-EXTER inline object ++INLINE object + immnum_minus(object x,object y) {return iif2(x,y) ? make_fixnum(fif(x)-fif(y)) : number_minus(x,y);} +-EXTER inline object ++INLINE object + immnum_negate(object x) {return iif(x) ? make_fixnum(-fif(x)) : number_negate(x);} + + #define BOOLCLR 0 +@@ -116,7 +116,7 @@ immnum_negate(object x) {return iif(x) ? + #define BOOLORC1 015 + #define BOOLORC2 013 + +-EXTER inline fixnum ++INLINE fixnum + fixnum_boole(fixnum op,fixnum x,fixnum y) { + switch(op) { + case BOOLCLR: return 0; +@@ -139,7 +139,7 @@ fixnum_boole(fixnum op,fixnum x,fixnum y + return 0;/*FIXME error*/ + } + +-EXTER inline object ++INLINE object + immnum_boole(fixnum o,object x,object y) {return iif2(x,y) ? mif(fixnum_boole(o,fif(x),fif(y))) : log_op2(o,x,y);} + + #define immnum_bool(o,x,y) immnum_boole(fixint(o),x,y) +@@ -156,93 +156,93 @@ immnum_boole(fixnum o,object x,object y) + #define immnum_orc1(x,y) immnum_boole(BOOLORC1,x,y) + #define immnum_orc2(x,y) immnum_boole(BOOLORC2,x,y) + +-EXTER inline fixnum ++INLINE fixnum + fixnum_div(fixnum x,fixnum y,fixnum d) { + fixnum z=x/y; + if (d && x!=y*z && (x*d>0 ? y>0 : y<0)) + z+=d; + return z; + } +-EXTER inline fixnum ++INLINE fixnum + fixnum_rem(fixnum x,fixnum y,fixnum d) { + fixnum z=x%y; + if (d && z && (x*d>0 ? y>0 : y<0)) + z+=y; + return z; + } +-EXTER inline object ++INLINE object + immnum_truncate(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),0)) : (intdivrem(x,y,0,&x,NULL),x);} +-EXTER inline object ++INLINE object + immnum_floor(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),-1)) : (intdivrem(x,y,-1,&x,NULL),x);} +-EXTER inline object ++INLINE object + immnum_ceiling(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_div(fif(x),fif(y),1)) : (intdivrem(x,y,1,&x,NULL),x);} +-EXTER inline object ++INLINE object + immnum_mod(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_rem(fif(x),fif(y),-1)) : (intdivrem(x,y,-1,NULL,&y),y);} +-EXTER inline object ++INLINE object + immnum_rem(object x,object y) {return iif2(x,y)&&y!=make_fixnum(0) ? mif(fixnum_rem(fif(x),fif(y),0)) : (intdivrem(x,y,0,NULL,&y),y);} + +-EXTER inline fixnum ++INLINE fixnum + fixnum_rshft(fixnum x,fixnum y) { + return y>=sizeof(x)*8 ? (x<0 ? -1 : 0) : x>>y; + } +-EXTER inline object ++INLINE object + fixnum_lshft(fixnum x,fixnum y) { + return clz(labs(x))>y ? make_fixnum(x<);} +-EXTER inline bool ++INLINE bool + immnum_ge(object x,object y) {return immnum_comp(x,y,>=);} + +-EXTER inline bool ++INLINE bool + immnum_minusp(object x) {return iif(x) ? ((ufixnum)x)<((ufixnum)make_fixnum(0)) : number_minusp(x);} +-EXTER inline bool ++INLINE bool + immnum_plusp(object x) {return iif(x) ? ((ufixnum)x)>((ufixnum)make_fixnum(0)) : number_plusp(x);} +-EXTER inline bool ++INLINE bool + immnum_zerop(object x) {return iif(x) ? ((ufixnum)x)==((ufixnum)make_fixnum(0)) : number_zerop(x);} +-EXTER inline bool ++INLINE bool + immnum_evenp(object x) {return iif(x) ? !(((ufixnum)x)&0x1) : number_evenp(x);} +-EXTER inline bool ++INLINE bool + immnum_oddp(object x) {return iif(x) ? (((ufixnum)x)&0x1) : number_oddp(x);} + +-EXTER inline object ++INLINE object + immnum_signum(object x) { + ufixnum ux=(ufixnum)x,uz=((ufixnum)make_fixnum(0)); + return iif(x) ? (ux=(ufixnum)y ? x : y) : (number_compare(x,y)>=0?x:y);} +-EXTER inline object ++INLINE object + immnum_min(object x,object y) {return iif2(x,y) ? ((ufixnum)x<=(ufixnum)y ? x : y) : (number_compare(x,y)<=0?x:y);} + +-EXTER inline bool ++INLINE bool + immnum_logt(object x,object y) {return iif2(x,y) ? fixnum_boole(BOOLAND,fif(x),fif(y))!=0 : !number_zerop(log_op2(BOOLAND,x,y));} + +-EXTER inline fixnum ++INLINE fixnum + fixnum_gcd(fixnum x,fixnum y) { + + fixnum t; +@@ -343,16 +343,16 @@ fixnum_gcd(fixnum x,fixnum y) { + + } + +-EXTER inline object ++INLINE object + immnum_gcd(object x,object y) {return iif2(x,y) ? mif(fixnum_gcd(labs(fif(x)),labs(fif(y)))) : get_gcd(x,y);} + +-EXTER inline object ++INLINE object + fixnum_lcm(fixnum x,fixnum y) { + fixnum g=fixnum_gcd(x,y); + return g ? safe_mul_abs(x,fixnum_div(y,g,0)) : make_fixnum(0); + } + +-EXTER inline object ++INLINE object + immnum_lcm(object x,object y) {return iif2(x,y) ? fixnum_lcm(labs(fif(x)),labs(fif(y))) : get_lcm(x,y);} + + #endif +--- gcl-2.6.12.orig/h/include.h ++++ gcl-2.6.12/h/include.h +@@ -87,12 +87,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + #define isalphanum(x) isalnum(x) + #endif + +-#ifdef IN_MAIN +-#define EXTER +-#else +-#define EXTER extern +-#endif +- + #if defined(GMP) || defined(NEED_MP_H) + #include "../h/mp.h" + #endif +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -28,10 +28,7 @@ EXTER long real_maxpage; + char *getenv(); + EXTER char *this_lisp; + +-#ifndef IN_MAIN +-EXTER +-char stdin_buf[], stdout_buf[]; +-#endif ++EXTER char stdin_buf[],stdout_buf[]; + + EXTER object user_package; + +--- gcl-2.6.12.orig/h/page.h ++++ gcl-2.6.12/h/page.h +@@ -106,7 +106,7 @@ extern fixnum writable_pages; + EXTER long first_data_page,real_maxpage,phys_pages,available_pages; + EXTER void *data_start,*initial_sbrk; + +-#if !defined(IN_MAIN) && defined(SGC) ++#if defined(SGC) + #include "writable.h" + #endif + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1,13 +1,12 @@ + /* alloc.c:89:OF */ extern void *alloc_page (long n); /* (n) int n; */ +-/* alloc.c:149:OF */ inline void add_page_to_freelist (char *p, struct typemanager *tm); /* (p, tm) char *p; struct typemanager *tm; */ + /* alloc.c:196:OF */ extern object type_name (int t); /* (t) int t; */ +-/* alloc.c:213:OF */ inline object alloc_object (enum type t); /* (t) enum type t; */ +-/* alloc.c:213:OF */ inline void add_pages(struct typemanager *,fixnum); +-/* alloc.c:296:OF */ extern inline object make_cons (object a, object d); /* (a, d) object a; object d; */ ++/* alloc.c:213:OF */ object alloc_object (enum type t); /* (t) enum type t; */ ++/* alloc.c:213:OF */ void add_pages(struct typemanager *,fixnum); ++/* alloc.c:296:OF */ extern object make_cons (object a, object d); /* (a, d) object a; object d; */ + /* alloc.c:364:OF */ extern object on_stack_cons (object x, object y); /* (x, y) object x; object y; */ + /* alloc.c:376:OF */ extern object fSallocated (object typ); /* (typ) object typ; */ + /* alloc.c:401:OF */ extern object fSreset_number_used (object typ); /* (typ) object typ; */ +-/* alloc.c:480:OF */ extern inline void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */ ++/* alloc.c:480:OF */ extern void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */ + /* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p, int s); /* (p, s) char *p; int s; */ + /* alloc.c:611:OF */ extern void set_maxpage (void); /* () */ + /* alloc.c:635:OF */ extern void gcl_init_alloc (void *); /* () */ +@@ -1841,43 +1840,40 @@ struct htent *gethash(object,object); + int + update_real_maxpage(void); + +-inline fixnum ++fixnum + set_tm_maxpage(struct typemanager *,fixnum); + + void + init_gmp_rnd_state(__gmp_randstate_struct *); + +-inline void +-set_sgc_bit(struct pageinfo *,void *); +- + void + reinit_gmp(void); + + object + mod(object,object); + +-inline void ++void + intdivrem(object,object,fixnum,object *,object *); + +-inline object ++object + integer_count(object); + +-inline object ++object + integer_length(object); + +-inline bool ++bool + integer_bitp(object,object); + +-inline object ++object + fixnum_times(fixnum,fixnum); + +-inline object ++object + log_op2(fixnum,object,object); + +-inline object ++object + fixnum_big_shift(fixnum,fixnum); + +-inline object ++object + integer_shift(object,object); + + object +@@ -1921,22 +1917,19 @@ sigint(void); + void + allocate_code_block_reserve(void); + +-inline void +-resize_hole(ufixnum,enum type); +- +-inline void * ++void * + alloc_contblock_no_gc(size_t); + +-inline void ++void + reset_contblock_freelist(void); + +-inline void ++void + empty_relblock(void); + + fixnum + check_avail_pages(void); + +-inline int ++int + mbrk(void *); + + void +@@ -1948,5 +1941,8 @@ alloc_code_space(size_t); + object + fSmake_vector1_2(fixnum,fixnum,object,object); + +-inline struct pageinfo * ++struct pageinfo * + get_pageinfo(void *); ++ ++void ++add_page_to_freelist(char *, struct typemanager *); +--- gcl-2.6.12.orig/h/writable.h ++++ gcl-2.6.12/h/writable.h +@@ -1,7 +1,7 @@ + EXTER fixnum last_page; + EXTER int last_result; + +-EXTER inline int ++INLINE int + set_writable(fixnum i,bool m) { + + fixnum j; +@@ -32,7 +32,7 @@ set_writable(fixnum i,bool m) { + + } + +-EXTER inline int ++INLINE int + is_writable(fixnum i) { + + fixnum j; +@@ -51,7 +51,7 @@ is_writable(fixnum i) { + + } + +-EXTER inline int ++INLINE int + is_writable_cached(fixnum i) { + + if (last_page==i) +--- gcl-2.6.12.orig/makefile ++++ gcl-2.6.12/makefile +@@ -265,7 +265,7 @@ $(HDIR)new_decl.h: + + $(HDIR)mcompdefs.h: $(HDIR)compdefs.h $(HDIR)new_decl.h + $(AWK) 'BEGIN {print "#include \"include.h\"";print "#include \"cmponly.h\"";print "---"} {a=$$1;gsub("\\.\\.\\.","",a);print "\"#define " $$1 "\" " a}' $< |\ +- $(CC) -E -I./$(HDIR) - |\ ++ $(CC) -E -P -I./$(HDIR) - |\ + $(AWK) '/^\-\-\-$$/ {i=1;next} {if (!i) next} {gsub("\"","");print}' >$@ + + $(HDIR)cmpinclude.h: $(HDIR)mcompdefs.h $(CMPINCLUDE_FILES) $(HDIR)config.h +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -134,7 +134,7 @@ acomp(const void *v1,const void *v2) { + + } + +-inline struct pageinfo * ++struct pageinfo * + get_pageinfo(void *x) { + + struct pageinfo **pp=bsearchleq(&x,contblock_array->v.v_self,contblock_array->v.v_fillp,sizeof(*contblock_array->v.v_self),acomp); +@@ -144,7 +144,7 @@ get_pageinfo(void *x) { + + } + +-inline void ++static inline void + add_page_to_contblock_list(void *p,fixnum m) { + + struct pageinfo *pp=pageinfo(p); +@@ -176,7 +176,70 @@ icomp(const void *v1,const void *v2) { + return *f1<*f2 ? -1 : *f1==*f2 ? 0 : +1; + } + +-inline void ++ ++void ++add_page_to_freelist(char *p, struct typemanager *tm) { ++ ++ short t,size; ++ long i=tm->tm_nppage,fw; ++ object x,f; ++ struct pageinfo *pp; ++ ++ t=tm->tm_type; ++ ++ size=tm->tm_size; ++ f=tm->tm_free; ++ pp=pageinfo(p); ++ bzero(pp,sizeof(*pp)); ++ pp->type=t; ++ pp->magic=PAGE_MAGIC; ++ ++ if (cell_list_head==NULL) ++ cell_list_tail=cell_list_head=pp; ++ else if (pp > cell_list_tail) { ++ cell_list_tail->next=pp; ++ cell_list_tail=pp; ++ } ++ ++ x= (object)pagetochar(page(p)); ++ /* set_type_of(x,t); */ ++ make_free(x); ++ ++#ifdef SGC ++ ++ if (sgc_enabled && tm->tm_sgc) ++ pp->sgc_flags=SGC_PAGE_FLAG; ++ ++#ifndef SGC_WHOLE_PAGE ++ if (TYPEWORD_TYPE_P(pp->type)) ++ x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; ++#endif ++ ++ /* array headers must be always writable, since a write to the ++ body does not touch the header. It may be desirable if there ++ are many arrays in a system to make the headers not writable, ++ but just SGC_TOUCH the header each time you write to it. this ++ is what is done with t_structure */ ++ if (t==(tm_of(t_array)->tm_type)) ++ pp->sgc_flags|=SGC_PERM_WRITABLE; ++ ++#endif ++ ++ fw= *(fixnum *)x; ++ while (--i >= 0) { ++ *(fixnum *)x=fw; ++ SET_LINK(x,f); ++ f=x; ++ x= (object) ((char *)x + size); ++ } ++ ++ tm->tm_free=f; ++ tm->tm_nfree += tm->tm_nppage; ++ tm->tm_npage++; ++ ++} ++ ++static inline void + maybe_reallocate_page(struct typemanager *ntm,ufixnum count) { + + void **y,**n; +@@ -248,7 +311,7 @@ int reserve_pages_for_signal_handler=30; + reserve_pages_for_signal_handler pages on hand in the hole + */ + +-inline void ++void + empty_relblock(void) { + + object o=sSAleaf_collection_thresholdA->s.s_dbind; +@@ -262,7 +325,7 @@ empty_relblock(void) { + + } + +-inline void ++static inline void + resize_hole(ufixnum hp,enum type tp) { + + char *new_start=heap_end+hp*PAGESIZE; +@@ -283,7 +346,7 @@ resize_hole(ufixnum hp,enum type tp) { + + } + +-inline void * ++void * + alloc_page(long n) { + + bool s=n<0; +@@ -332,7 +395,7 @@ alloc_page(long n) { + + struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;; + +-inline ufixnum ++static inline ufixnum + sum_maxpages(void) { + + ufixnum i,j; +@@ -352,7 +415,7 @@ check_avail_pages(void) { + } + + +-inline fixnum ++fixnum + set_tm_maxpage(struct typemanager *tm,fixnum n) { + + fixnum r=tm->tm_type==t_relocatable,j=tm->tm_maxpage,z=(n-j)*(r ? 2 : 1); +@@ -365,69 +428,6 @@ set_tm_maxpage(struct typemanager *tm,fi + return 1; + } + +- +-inline void +-add_page_to_freelist(char *p, struct typemanager *tm) { +- +- short t,size; +- long i=tm->tm_nppage,fw; +- object x,f; +- struct pageinfo *pp; +- +- t=tm->tm_type; +- +- size=tm->tm_size; +- f=tm->tm_free; +- pp=pageinfo(p); +- bzero(pp,sizeof(*pp)); +- pp->type=t; +- pp->magic=PAGE_MAGIC; +- +- if (cell_list_head==NULL) +- cell_list_tail=cell_list_head=pp; +- else if (pp > cell_list_tail) { +- cell_list_tail->next=pp; +- cell_list_tail=pp; +- } +- +- x= (object)pagetochar(page(p)); +- /* set_type_of(x,t); */ +- make_free(x); +- +-#ifdef SGC +- +- if (sgc_enabled && tm->tm_sgc) +- pp->sgc_flags=SGC_PAGE_FLAG; +- +-#ifndef SGC_WHOLE_PAGE +- if (TYPEWORD_TYPE_P(pp->type)) +- x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; +-#endif +- +- /* array headers must be always writable, since a write to the +- body does not touch the header. It may be desirable if there +- are many arrays in a system to make the headers not writable, +- but just SGC_TOUCH the header each time you write to it. this +- is what is done with t_structure */ +- if (t==(tm_of(t_array)->tm_type)) +- pp->sgc_flags|=SGC_PERM_WRITABLE; +- +-#endif +- +- fw= *(fixnum *)x; +- while (--i >= 0) { +- *(fixnum *)x=fw; +- SET_LINK(x,f); +- f=x; +- x= (object) ((char *)x + size); +- } +- +- tm->tm_free=f; +- tm->tm_nfree += tm->tm_nppage; +- tm->tm_npage++; +- +-} +- + object + type_name(int t) { + return make_simple_string(tm_table[(int)t].tm_name+1); +@@ -435,7 +435,7 @@ type_name(int t) { + + + static void +-call_after_gbc_hook(t) { ++call_after_gbc_hook(int t) { + if (sSAafter_gbc_hookA && sSAafter_gbc_hookA->s.s_dbind!= Cnil) { + set_up_string_register(tm_table[(int)t].tm_name+1); + ifuncall1(sSAafter_gbc_hookA->s.s_dbind,intern(string_register,system_package)); +@@ -536,7 +536,7 @@ rebalance_maxpages(struct typemanager *m + + } + +-inline long ++long + opt_maxpage(struct typemanager *my_tm) { + + double x=0.0,y=0.0,z,r; +@@ -707,7 +707,7 @@ find_contblock(ufixnum n,void **p) { + return find_cbpp(*p,n); + } + +-inline void ++void + print_cb(int print) { + + struct contblock *cbp,***cbppp,**cbpp=&cb_pointer; +@@ -729,7 +729,7 @@ print_cb(int print) { + + } + +-inline void ++void + insert_contblock(void *p,ufixnum s) { + + struct contblock *cbp=p,**cbpp,***cbppp; +@@ -761,7 +761,7 @@ delete_contblock(void *p,struct contbloc + + } + +-inline void ++void + reset_contblock_freelist(void) { + + cb_pointer=NULL; +@@ -769,7 +769,7 @@ reset_contblock_freelist(void) { + + } + +-inline void * ++static inline void * + alloc_from_freelist(struct typemanager *tm,fixnum n) { + + void *p; +@@ -851,7 +851,7 @@ too_full_p(struct typemanager *tm) { + + } + +-inline void * ++static inline void * + alloc_after_gc(struct typemanager *tm,fixnum n) { + + if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) { +@@ -883,7 +883,7 @@ alloc_after_gc(struct typemanager *tm,fi + + } + +-inline void ++void + add_pages(struct typemanager *tm,fixnum m) { + + switch (tm->tm_type) { +@@ -923,7 +923,7 @@ add_pages(struct typemanager *tm,fixnum + + } + +-inline void * ++static inline void * + alloc_after_adding_pages(struct typemanager *tm,fixnum n) { + + fixnum m=tpage(tm,n); +@@ -945,7 +945,7 @@ alloc_after_adding_pages(struct typemana + + } + +-inline void * ++static inline void * + alloc_after_reclaiming_pages(struct typemanager *tm,fixnum n) { + + fixnum m=tpage(tm,n),reloc_min; +@@ -972,10 +972,10 @@ alloc_after_reclaiming_pages(struct type + + } + +-inline void *alloc_mem(struct typemanager *,fixnum); ++static inline void *alloc_mem(struct typemanager *,fixnum); + + #ifdef SGC +-inline void * ++static inline void * + alloc_after_turning_off_sgc(struct typemanager *tm,fixnum n) { + + if (!sgc_enabled) return NULL; +@@ -985,7 +985,7 @@ alloc_after_turning_off_sgc(struct typem + } + #endif + +-inline void * ++static inline void * + alloc_mem(struct typemanager *tm,fixnum n) { + + void *p; +@@ -1007,7 +1007,7 @@ alloc_mem(struct typemanager *tm,fixnum + return exhausted_report(tm->tm_type,tm); + } + +-inline object ++object + alloc_object(enum type t) { + + object obj; +@@ -1022,12 +1022,12 @@ alloc_object(enum type t) { + + } + +-inline void * ++void * + alloc_contblock(size_t n) { + return alloc_mem(tm_of(t_contiguous),CEI(n,CPTR_SIZE)); + } + +-inline void * ++void * + alloc_contblock_no_gc(size_t n) { + + struct typemanager *tm=tm_of(t_contiguous); +@@ -1073,7 +1073,7 @@ alloc_code_space(size_t sz) { + + } + +-inline void * ++void * + alloc_relblock(size_t n) { + + return alloc_mem(tm_of(t_relocatable),CEI(n,PTR_ALIGN)); +@@ -1089,7 +1089,7 @@ load_cons(object p,object a,object d) { + p->c.c_car=a; + } + +-inline object ++object + make_cons(object a,object d) { + + static struct typemanager *tm=tm_table+t_cons;/*FIXME*/ +@@ -1105,7 +1105,7 @@ make_cons(object a,object d) { + + + +-inline object on_stack_cons(object x, object y) { ++object on_stack_cons(object x, object y) { + object p = (object) alloca_val; + load_cons(p,x,y); + return p; +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -158,7 +158,7 @@ in_contblock_stack_list(void *p,void *** + return a && a[0]==p; + } + +-inline char ++static inline char + get_bit(char *v,struct pageinfo *pi,void *x) { + void *ve=CB_DATA_START(pi); + fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1; + } + +-inline void ++static inline void + set_bit(char *v,struct pageinfo *pi,void *x) { + void *ve=CB_DATA_START(pi); + fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>LOG_BYTES_CONTBLOCK;i=_o>>LOG_BITS_CHAR;s=_o&~(~0UL< + void change_contexts(); +@@ -47,6 +45,11 @@ int ovm_process_created; + void initialize_process(); + #endif + ++ ++#define EXTER ++#define INLINE ++ ++ + #include "include.h" + #include + #include "page.h" +@@ -118,7 +121,7 @@ cstack_dir(fixnum j) { + + fixnum log_maxpage_bound=sizeof(fixnum)*8-1; + +-inline int ++int + mbrk(void *v) { + + ufixnum uv=(ufixnum)v,uc=(ufixnum)sbrk(0),ux,um; +@@ -1120,10 +1123,6 @@ init_main(void) { + + } + +-#ifdef SGC +-#include "writable.h" +-#endif +- + #ifdef HAVE_PRINT_INSN_I386 + + #include "dis-asm.h" +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -20,7 +20,7 @@ OBJS:=$(addsuffix .o,typespec main alloc + num_pred num_comp num_arith num_sfun num_co num_log num_rand earith character sequence list hash\ + array string regexpr structure toplevel file read backq print format pathname unixfsys unixfasl\ + error unixtime unixsys unixsave funlink fat_string run_process nfunlink usig usig2 utils makefun\ +- sockets gmp_wrappers clxsocket init_pari nsocket sfasl prelink) ++ sockets clxsocket init_pari nsocket sfasl prelink) + OBJS:=$(OBJS) $(RL_OBJS) $(EXTRAS) + + INI_FILES=$(patsubst %.o,%.ini,${OBJS}) +--- gcl-2.6.12.orig/o/num_arith.c ++++ gcl-2.6.12/o/num_arith.c +@@ -62,7 +62,7 @@ object fixnum_sub(fixnum i, fixnum j) + } + } + +-inline object ++object + fixnum_times(fixnum i, fixnum j) { + + #ifdef HAVE_CLZL +--- gcl-2.6.12.orig/o/num_co.c ++++ gcl-2.6.12/o/num_co.c +@@ -277,7 +277,7 @@ LFD(Ldenominator)(void) + vs_base[0] = small_fixnum(1); + } + +-inline void ++void + intdivrem(object x,object y,fixnum d,object *q,object *r) { + + enum type tx=type_of(x),ty=type_of(y); +--- gcl-2.6.12.orig/o/num_log.c ++++ gcl-2.6.12/o/num_log.c +@@ -37,12 +37,12 @@ Foundation, 675 Mass Ave, Cambridge, MA + + + +-inline object ++object + fixnum_big_shift(fixnum x,fixnum w) { + MPOP(return,shifti,SI_TO_MP(x,big_fixnum1),w); + } + +-inline object ++object + integer_fix_shift(object x, fixnum w) { + if (type_of(x)==t_fixnum) { + fixnum fx=fix(x); +@@ -51,7 +51,7 @@ integer_fix_shift(object x, fixnum w) { + MPOP(return,shifti,MP(x),w); + } + +-inline object ++object + integer_shift(object x,object y) { + enum type tx=type_of(x),ty=type_of(y); + if (ty==t_fixnum) +@@ -66,12 +66,12 @@ integer_shift(object x,object y) { + } + } + +-inline object ++object + integer_length(object x) { + return make_fixnum(type_of(x)==t_fixnum ? fixnum_length(fix(x)) : MP_SIZE_IN_BASE2(MP(x))); + } + +-inline object ++object + integer_count(object x) { + return make_fixnum(type_of(x)==t_fixnum ? fixnum_count(fix(x)) : MP_BITCOUNT(MP(x))); + } +@@ -120,7 +120,7 @@ LFD(Lboole)(void) + + } + +-inline bool ++bool + integer_bitp(object p,object x) { + enum type tp=type_of(p),tx=type_of(x); + +--- gcl-2.6.12.orig/o/num_sfun.c ++++ gcl-2.6.12/o/num_sfun.c +@@ -94,7 +94,7 @@ number_exp(object x) + } + } + +-inline object ++static inline object + number_fix_iexpt(object x,fixnum y,fixnum ly,fixnum j) { + object z; + +@@ -103,7 +103,7 @@ number_fix_iexpt(object x,fixnum y,fixnu + return fixnum_bitp(j,y) ? number_times(x,z) : z; + } + +-inline object ++static inline object + number_big_iexpt(object x,object y,fixnum ly,fixnum j) { + object z; + +@@ -113,7 +113,7 @@ number_big_iexpt(object x,object y,fixnu + + } + +-inline object ++static inline object + number_zero_expt(object x,bool promote_short_p) { + + switch (type_of(x)) { +@@ -135,7 +135,7 @@ number_zero_expt(object x,bool promote_s + } + + +-inline object ++static inline object + number_ui_expt(object x,fixnum fy) { + + switch (type_of(x)) { +@@ -173,17 +173,17 @@ number_ui_expt(object x,fixnum fy) { + + } + +-inline object ++static inline object + number_ump_expt(object x,object y) { + return number_big_iexpt(x,y,fix(integer_length(y)),0); + } + +-inline object ++static inline object + number_log_expt(object x,object y) { + return number_zerop(y) ? number_zero_expt(y,type_of(x)==t_longfloat) : number_exp(number_times(number_nlog(x),y)); + } + +-inline object ++static inline object + number_invert(object x,object y,object z) { + + switch (type_of(z)) { +@@ -198,7 +198,7 @@ number_invert(object x,object y,object z + } + + +-inline object ++static inline object + number_si_expt(object x,object y) { + switch (type_of(y)) { + case t_fixnum: +--- gcl-2.6.12.orig/o/package.d ++++ gcl-2.6.12/o/package.d +@@ -114,7 +114,7 @@ static int package_sizes[]={ + 32749, 65521, 131071, 262139, 524287, 1048573}; + + static int +-suitable_package_size(n) ++suitable_package_size(int n) + {int *i=package_sizes; + if (n>= 1000000) return 1048573; + while(*i < n) { i++;} diff --git a/patches/Version_2_6_13pre8b b/patches/Version_2_6_13pre8b new file mode 100644 index 00000000..fef1bb0f --- /dev/null +++ b/patches/Version_2_6_13pre8b @@ -0,0 +1,43 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-9) unstable; urgency=medium + . + * Version_2_6_13pre8a + * Bug fix: "ftbfs with GCC-5", thanks to Matthias Klose (Closes: + #777866). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/777866 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/prelink.c ++++ gcl-2.6.12/o/prelink.c +@@ -2,6 +2,12 @@ + + #include "include.h" + ++extern FILE *stdin __attribute__((weak)); ++extern FILE *stderr __attribute__((weak)); ++extern FILE *stdout __attribute__((weak)); ++extern rl_compentry_func_t *rl_completion_entry_function __attribute__((weak)); ++extern const char *rl_readline_name __attribute__((weak)); ++ + void + prelink_init(void) { + diff --git a/patches/Version_2_6_13pre90 b/patches/Version_2_6_13pre90 new file mode 100644 index 00000000..fe7aa971 --- /dev/null +++ b/patches/Version_2_6_13pre90 @@ -0,0 +1,90 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-93) unstable; urgency=medium + . + * Version_2_6_13pre90 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2020-02-21 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -3974,7 +3974,7 @@ $as_echo "removing $1 from LDFLAGS" >&6; + + } + +-add_args_to_cflags -fsigned-char -pipe \ ++add_args_to_cflags -fsigned-char -pipe -fcommon \ + -fno-builtin-malloc -fno-builtin-free \ + -fno-PIE -fno-pie -fno-PIC -fno-pic \ + -Wall \ +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -258,7 +258,7 @@ remove_arg_from_ldflags() { + + } + +-add_args_to_cflags -fsigned-char -pipe \ ++add_args_to_cflags -fsigned-char -pipe -fcommon \ + -fno-builtin-malloc -fno-builtin-free \ + -fno-PIE -fno-pie -fno-PIC -fno-pic \ + -Wall \ +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -445,20 +445,21 @@ gcl_cleanup(int gc) { + } + + /*gcc boolean expression tail position bug*/ ++static char *stack_to_be_allocated; + +-void * +-cclear_stack(unsigned long size) { +- void *v=alloca(size); +- memset(v,0,size); +- return v; ++void ++get_stack_to_be_allocated(unsigned long size) { ++ stack_to_be_allocated=alloca(size); + } + + DEFUN_NEW("EQUAL-TAIL-RECURSION-CHECK",object,fSequal_tail_recursion_check,SI,1,1,NONE,II,OO,OO,OO,(fixnum s),"") { + object x0=make_list(s/sizeof(object)),x1=make_list(s/sizeof(object)); +- char *u=cclear_stack(s),*w; ++ char *w; ++ get_stack_to_be_allocated(s); ++ memset(stack_to_be_allocated,0,s); + fLequal(x0,x1); +- for (w=u;w + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-95) unstable; urgency=high + . + * Version_2_6_13pre90 + * build under GCL_MEM_MULTIPLE=0.1 + * Bug fix: "FTBFS: Unrecoverable error: Segmentation violation..", + thanks to Lucas Nussbaum (Closes: #952334). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/952334 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2020-08-23 + +--- gcl-2.6.12.orig/h/elf32_armhf_reloc_special.h ++++ gcl-2.6.12/h/elf32_armhf_reloc_special.h +@@ -6,13 +6,15 @@ static ul tz=sizeof(tramp)/sizeof(ul); + static ul * + next_plt_entry(ul *p,ul *pe) { + +- ul l0=0xe5bef000,/*ldr pc,[ip,#]*/ +- l1=0xe5bcf000;/*ldr pc,[lr,#]*/ ++ /* 4778 bx pc */ /*optional*/ ++ /* e7fd b.n 20dd0 <__fprintf_chk@plt> */ /*optional*/ ++ /* above when stripped becomes undefined instruction*/ ++ /* e28fc601 add ip, pc, #1048576 ; 0x100000 */ ++ /* e28ccab0 add ip, ip, #176, 20 ; 0xb0000 */ ++ /* e5bcf914 ldr pc, [ip, #2324]! ; 0x914 */ + +- for (;p>20)!=0xe28;p++); ++ return p; + + } + diff --git a/patches/Version_2_6_13pre94 b/patches/Version_2_6_13pre94 new file mode 100644 index 00000000..1ad63f45 --- /dev/null +++ b/patches/Version_2_6_13pre94 @@ -0,0 +1,39 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-97) unstable; urgency=medium + . + * Bug fix: "Removal of obsolete debhelper compat 5 and 6 in bookworm", + thanks to Niels Thykier (Closes: #965543). + * Version_2.6.13pre93 +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/965543 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2020-09-29 + +--- gcl-2.6.12.orig/o/regexpr.c ++++ gcl-2.6.12/o/regexpr.c +@@ -157,7 +157,7 @@ be over written. \ + + + str=string->st.st_self; +- if (str+end==(void *)core_end || str+end==(void *)compiled_regexp) { ++ if (NULL_OR_ON_C_STACK(str+end) || str+end==(void *)compiled_regexp) { + + if (!(str=alloca(string->st.st_fillp+1))) + FEerror("Cannot allocate memory on C stack",0); diff --git a/patches/Version_2_6_13pre95 b/patches/Version_2_6_13pre95 new file mode 100644 index 00000000..810239d0 --- /dev/null +++ b/patches/Version_2_6_13pre95 @@ -0,0 +1,67 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-98) unstable; urgency=medium + . + * Version_2.6.13pre94 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2020-11-28 + +--- gcl-2.6.12.orig/h/compprotos.h ++++ gcl-2.6.12/h/compprotos.h +@@ -179,5 +179,5 @@ void gcl_init_or_load1(void (*)(void),co + char *gcl_gets(char *,int); + int gcl_puts(const char *); + int endp_error(object); +-object Icall_gen_error_handler(object,object,object,object,ufixnum,...); ++object Icall_gen_error_handler(object,object,object,object,ufixnum,...) __attribute__((noreturn)); + object file_stream(object); +--- gcl-2.6.12.orig/h/elf32_armhf_reloc.h ++++ gcl-2.6.12/h/elf32_armhf_reloc.h +@@ -4,7 +4,7 @@ + case R_ARM_THM_JUMP24: + { + long x=(long)(s+a-p); +- if (abs(x)&(~MASK(23))) { ++ if (abs(x)&(~MASK(22))) { + + got+=(sym->st_size-1)*tz; + memcpy(got,tramp,sizeof(tramp)); +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -391,9 +391,6 @@ emsg(const char *s,...) { + va_list args; + ufixnum n=0; + void *v=NULL; +-#ifndef vsnprintf +- extern int vsnprintf(); +-#endif + va_start(args,s); + n=vsnprintf(v,n,s,args)+1; + va_end(args); +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -1590,6 +1590,7 @@ object from, to; + if (to == Cnil) { + to = alloc_object(t_readtable); + to->rt.rt_self = NULL; ++ to->rt.rt_case = sKupcase; + /* For GBC not to go mad. */ + vs_push(to); + /* Saving for GBC. */ diff --git a/patches/ansi-test-clean-target b/patches/ansi-test-clean-target new file mode 100644 index 00000000..15f42d93 --- /dev/null +++ b/patches/ansi-test-clean-target @@ -0,0 +1,33 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-39) unstable; urgency=medium + . + * pathnames1.1 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-12 + +--- gcl-2.6.12.orig/ansi-tests/makefile ++++ gcl-2.6.12/ansi-tests/makefile +@@ -8,3 +8,5 @@ test: + + clean: + rm -f test.out *.fasl *.o *.so *~ *.fn *.x86f *.fasl *.ufsl ++ rm -f foo.txt temp.dat file-that-was-renamed.txt tmp.dat tmp.dat.BAK tmp2.dat ++ rm -rf scratch tmp.txt foo.lsp 'CLTEST:foo.txt' diff --git a/patches/data_bss_offset-in-unexec-sparc64-fix b/patches/data_bss_offset-in-unexec-sparc64-fix new file mode 100644 index 00000000..08d1543d --- /dev/null +++ b/patches/data_bss_offset-in-unexec-sparc64-fix @@ -0,0 +1,83 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-31) unstable; urgency=medium + . + * Version_2_6_13pre39 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: + +--- gcl-2.6.12.orig/o/unexelf.c ++++ gcl-2.6.12/o/unexelf.c +@@ -428,6 +428,8 @@ extern void fatal (char *, ...); + #include /* for HDRR declaration */ + #endif /* __sgi */ + ++#include "page.h" ++ + #ifndef MAP_ANON + #ifdef MAP_ANONYMOUS + #define MAP_ANON MAP_ANONYMOUS +@@ -655,7 +657,7 @@ unexec (char *new_name, char *old_name, + char *old_section_names; + + ElfW(Addr) old_bss_addr, new_bss_addr,new_data2_addr; +- ElfW(Off) old_bss_size, new_data2_size,old_bss_offset,new_data2_offset,old_file_size,new_file_size; ++ ElfW(Off) old_bss_size, new_data2_size,old_bss_offset,new_data2_offset,old_file_size,new_file_size,data_bss_offset; + + int n, nn; + int old_bss_index, old_sbss_index; +@@ -772,7 +774,9 @@ unexec (char *new_name, char *old_name, + if (new_file < 0) + fatal ("Can't creat (%s): errno %d\n", new_name, errno); + +- new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size + (new_data2_offset-old_bss_offset); ++ data_bss_offset=CEI(new_data2_offset-old_bss_offset,sizeof(long));/*????, e.g. sparc64*/ ++ ++ new_file_size = stat_buf.st_size + old_file_h->e_shentsize + new_data2_size + data_bss_offset; + + if (ftruncate (new_file, new_file_size)) + fatal ("Can't ftruncate (%s): errno %d\n", new_name, errno); +@@ -784,7 +788,7 @@ unexec (char *new_name, char *old_name, + new_file_h = (ElfW(Ehdr) *) new_base; + new_program_h = (ElfW(Phdr) *) ((byte *) new_base + old_file_h->e_phoff); + new_section_h = (ElfW(Shdr) *) +- ((byte *) new_base + old_file_h->e_shoff + new_data2_size + (new_data2_offset-old_bss_offset)); ++ ((byte *) new_base + old_file_h->e_shoff + new_data2_size + data_bss_offset); + + + /* Make our new file, program and section headers as copies of the +@@ -802,7 +806,7 @@ unexec (char *new_name, char *old_name, + * further away now. + */ + +- new_file_h->e_shoff += new_data2_size + (new_data2_offset-old_bss_offset); ++ new_file_h->e_shoff += new_data2_size + data_bss_offset; + new_file_h->e_shnum += 1; + + #ifdef DEBUG +@@ -958,7 +962,7 @@ unexec (char *new_name, char *old_name, + if (NEW_SECTION_H (nn).sh_offset >= old_bss_offset || + /* solaris has symtab straddling bss offset */ + NEW_SECTION_H (nn).sh_offset+NEW_SECTION_H (nn).sh_size > old_bss_offset) +- NEW_SECTION_H (nn).sh_offset += new_data2_size+(new_data2_offset-old_bss_offset); ++ NEW_SECTION_H (nn).sh_offset += new_data2_size+data_bss_offset; + #endif + /* Any section that was originally placed after the section + header table should now be off by the size of one section diff --git a/patches/defined_real_maxpage b/patches/defined_real_maxpage new file mode 100644 index 00000000..4fe1d27f --- /dev/null +++ b/patches/defined_real_maxpage @@ -0,0 +1,71 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-50) unstable; urgency=medium + . + * list_order.6 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-14 + +--- gcl-2.6.12.orig/h/386-gnu.h ++++ gcl-2.6.12/h/386-gnu.h +@@ -59,3 +59,5 @@ + #define RELOC_H "elf32_i386_reloc.h" + + #define NEED_STACK_CHK_GUARD ++ ++#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ +--- gcl-2.6.12.orig/h/m68k-linux.h ++++ gcl-2.6.12/h/m68k-linux.h +@@ -78,3 +78,5 @@ int cacheflush(void *,int,int,int); + #define RELOC_H "elf32_m68k_reloc.h" + + #define NEED_STACK_CHK_GUARD ++ ++#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ +--- gcl-2.6.12.orig/h/sh4-linux.h ++++ gcl-2.6.12/h/sh4-linux.h +@@ -56,3 +56,5 @@ + #define RELOC_H "elf32_sh4_reloc.h" + + #define NEED_STACK_CHK_GUARD ++ ++#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -302,6 +302,9 @@ update_real_maxpage(void) { + } + #endif + ++#ifdef DEFINED_REAL_MAXPAGE ++ real_maxpage=DEFINED_REAL_MAXPAGE; ++#else + massert(cur=sbrk(0)); + beg=data_start ? data_start : cur; + for (i=0,j=(1L<PAGESIZE;j>>=1) +@@ -311,7 +314,8 @@ update_real_maxpage(void) { + i+=j; + } + massert(!mbrk(cur)); +- ++#endif ++ + phys_pages=ufmin(get_phys_pages1(0)+page(beg),real_maxpage)-page(beg); + + get_gc_environ(); diff --git a/patches/disable_gprof_aarch64 b/patches/disable_gprof_aarch64 new file mode 100644 index 00000000..239d89c2 --- /dev/null +++ b/patches/disable_gprof_aarch64 @@ -0,0 +1,56 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-54) unstable; urgency=medium + . + * list_order.11 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-08-24 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4122,6 +4122,7 @@ $as_echo_n "checking working gprof... " + ia64*) enableval="no";; + hppa*) enableval="no";; + arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac + if test "$enableval" != "yes" ; then +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -335,6 +335,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + ia64*) enableval="no";; + hppa*) enableval="no";; + arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ aarch64*) enableval="no";;#unreproducible buildd bug 20170824 + *gnu) enableval="no";; + esac + if test "$enableval" != "yes" ; then +--- gcl-2.6.12.orig/o/regexp.c ++++ gcl-2.6.12/o/regexp.c +@@ -231,7 +231,7 @@ int case_fold_search = 0; + * of the structure of the compiled regexp. + */ + static regexp * +-regcomp(char *exp,int *sz) ++regcomp(char *exp,ufixnum *sz) + { + register regexp *r; + register char *scan; diff --git a/patches/list_order.1 b/patches/list_order.1 new file mode 100644 index 00000000..f04c29e2 --- /dev/null +++ b/patches/list_order.1 @@ -0,0 +1,8651 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-47) unstable; urgency=high + . + * pathnames1.13 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-05-28 + +--- gcl-2.6.12.orig/clcs/sys-proclaim.lisp ++++ gcl-2.6.12/clcs/sys-proclaim.lisp +@@ -4,7 +4,9 @@ + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM)) ++ COMMON-LISP::DEFINE-CONDITION COMMON-LISP::HANDLER-CASE ++ COMMON-LISP::IGNORE-ERRORS COMMON-LISP::HANDLER-BIND ++ CONDITIONS::SLOT-SYM CONDITIONS::COERCE-TO-FN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +@@ -20,27 +22,27 @@ + CONDITIONS::|(PCL::FAST-METHOD MAKE-LOAD-FORM (CONDITION))|)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- CONDITIONS::IS-CONDITION CONDITIONS::DEFAULT-REPORT +- CONDITIONS::IS-WARNING CONDITIONS::CONDITIONP)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| + CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| + CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| + CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| + CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))|)) +\ No newline at end of file ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ CONDITIONS::CONDITIONP CONDITIONS::DEFAULT-REPORT ++ CONDITIONS::IS-CONDITION CONDITIONS::IS-WARNING)) +\ No newline at end of file +--- gcl-2.6.12.orig/cmpnew/gcl_cmpcall.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpcall.lsp +@@ -27,8 +27,7 @@ + (eval-when (compile eval) + (defmacro link-arg-p (x) + `(let ((.u ,x)) +- (not (member .u '(character boolean long-float short-float))))) +-) ++ (not (member .u '(character boolean long-float short-float) :test 'eq))))) + + (defun fast-link-proclaimed-type-p (fname &optional args) + (and +@@ -134,6 +133,7 @@ + (let ((*vs* *vs*) (form (caddr funob))) + (declare (object form)) + (cond ((and (listp args) ++ (< (length args) 12) ;FIXME fcalln1 limitation + *use-sfuncall* + ;;Determine if only one value at most is required: + (or +@@ -167,8 +167,9 @@ + (defun fcalln-inline (&rest args) + (wt-nl "({object _f=" (car args) ";enum type _t=type_of(_f);") + (wt-nl "_f = _t==t_symbol && _f->s.s_gfdef!=OBJNULL ? (_t=type_of(_f->s.s_gfdef),_f->s.s_gfdef) : _f;") +- (wt-nl "_t==t_sfun ? _f->sfn.sfn_self : ") +- (wt-nl "(fcall.argd= " (length (cdr args)) ",_t==t_vfun ? _f->vfn.vfn_self : ") ++ (wt-nl "_t==t_sfun&&(_f->sfn.sfn_argd&0xff)== " (length (cdr args)) " ? _f->sfn.sfn_self : ") ++ (wt-nl "(fcall.argd= " (length (cdr args)) ++ ",_t==t_vfun&&_f->vfn.vfn_minargs<= " (length (cdr args)) "&&" (length (cdr args)) "<=_f->vfn.vfn_maxargs ? _f->vfn.vfn_self : ") + (wt-nl "(fcall.fun=_f,fcalln));})") + (wt-nl "(") + (when (cdr args) (wt (cadr args)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp +@@ -376,9 +376,7 @@ + doc form) + (loop + (when (endp body) (return)) +- (setq form (cmp-macroexpand (car body))) +- (when (and (consp form) (eq (car form) 'load-time-value)) +- (setq form (cmp-eval form))) ++ (setq form (car body)) + (cond + ((stringp form) + (when (or (null doc-p) (endp (cdr body)) doc) (return)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp +@@ -603,7 +603,9 @@ + (t + `(si::structure-subtype-p + ,x ',type)))) +-; ((and (print (list 'slow 'typep type)) nil)) ++ ((and (symbolp type) (setq tem (get type 'si::deftype-definition))) ++ `(typep ,x ',(funcall tem))) ++ ;; ((and (print (list 'slow 'typep type)) nil)) + (t nil))) + (and new (c1expr `(the boolean , new))))) + +@@ -877,36 +879,6 @@ + (c1expr (cmp-eval (cons f args)))))) + + +-(si::putprop 'do 'co1special-fix-decl 'co1special) +-(si::putprop 'do* 'co1special-fix-decl 'co1special) +-(si::putprop 'prog 'co1special-fix-decl 'co1special) +-(si::putprop 'prog* 'co1special-fix-decl 'co1special) +- +-(defun co1special-fix-decl (f args) +- (flet ((fixup (forms &aux decls ) +- (block nil +- (tagbody +- top +- (or (consp forms) (go end)) +- (let ((tem (car forms))) +- (if (and (consp tem) +- (setq tem (cmp-macroexpand tem)) +- (eq (car tem) 'declare)) +- (progn (push tem decls) (pop forms)) +- (go end))) +- (go top) +- ; all decls made explicit. +- end +- (return (nconc (nreverse decls) forms)))))) +- (c1expr +- (cmp-macroexpand +- (case f +- ((do do*) `(,f ,(car args) +- ,(second args) +- ,@ (fixup (cddr args)))) +- ((prog prog*) +- `(,f ,(car args) +- ,@ (fixup (cdr args))))))))) + (si::putprop 'sublis 'co1sublis 'co1) + (defun co1sublis (f args &aux test) f + (and (case (length args) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpinline.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpinline.lsp +@@ -465,7 +465,7 @@ + (t . INLINE))) + + (defun inline-type (type) +- (or (cdr (assoc type *inline-types*)) 'inline)) ++ (or (cdr (assoc type *inline-types* :test 'eq)) 'inline)) + + (defun get-inline-info (fname args return-type &aux x ii) + (and (fast-link-proclaimed-type-p fname args) +--- gcl-2.6.12.orig/cmpnew/gcl_cmplam.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmplam.lsp +@@ -475,9 +475,9 @@ + (*unwind-exit* *unwind-exit*) + (*ccb-vs* *ccb-vs*)) + (when rest +- (wt-nl "vs_top[0]=Cnil;") +- (wt-nl "{object *p=vs_top, *q=vs_base+" (length optionals) ";") +- (wt-nl " for(;p>q;p--)p[-1]=MMcons(p[-1],p[0]);}")) ++ (wt-nl "{object *q=vs_base+" (length optionals) ",*l;") ++ (wt-nl " for (l=q;qc.c_cdr) *l=MMcons(*q,Cnil);") ++ (wt-nl " *l=Cnil;}")) + (do ((opts optionals (cdr opts))) + ((endp opts)) + (declare (object opts)) +@@ -510,11 +510,11 @@ + + (wt-label label))) + (rest +- (wt-nl "vs_top[0]=Cnil;") +- (wt-nl "{object *p=vs_top;") +- (wt-nl " for(;p>vs_base;p--)p[-1]=" ++ (wt-nl "{object *q=vs_base,*l;") ++ (wt-nl " for (l=q;qc.c_cdr) *l=" + (if *rest-on-stack* "ON_STACK_CONS" "MMcons") +- "(p[-1],p[0]);}") ++ "(*q,Cnil);") ++ (wt-nl " *l=Cnil;}") + (c2bind rest) + (wt-nl) + (reset-top)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp +@@ -108,22 +108,11 @@ + (unwind-exit 'fun-val nil (if top-data (car top-data))) + ) + +-(defun c1values (args &aux (info (make-info))) +- (cond ((and args (not (cdr args)) +- (or (not (consp (car args))) +- (and (symbolp (caar args)) +- (let ((tem (get-return-type (caar args)))) +- (and tem +- (or (atom tem) +- (and (consp tem) +- (null (cdr tem)) +- (not (eq '* (car tem)))))))))) +- ;;the compiler put in unnecessary code +- ;;if we just had say (values nil) +- ;; so if we know there's one value only: +- (c1expr (car args))) +- (t (setq args (c1args args info)) +- (list 'values info args)))) ++(defun c1values (args &aux (info (make-info))(s (si::sgen "VALUES"))) ++ (cond ((and args (not (cdr args))) ++ (c1expr `(let ((,s ,(car args))) ,s))) ++ (t (setq args (c1args args info)) ++ (list 'values info args)))) + + (defun c2values (forms &aux (base *vs*) (*vs* *vs*)) + (cond ((and (eq *value-to-go* 'return-object) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpopt.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpopt.lsp +@@ -66,6 +66,10 @@ + (push '((t) boolean #.(flags)"type_of(#0)==t_longfloat") + (get 'long-float-p 'inline-always)) + ++;;COMPLEX-P ++ (push '((t) boolean #.(flags)"type_of(#0)==t_complex") ++ (get 'si::complexp 'inline-always)) ++ + ;;SFEOF + (push '((object) boolean #.(flags set)"(gcl_feof((#0)->sm.sm_fp))") + (get 'sfeof 'inline-unsafe)) +@@ -479,21 +483,56 @@ + (get 'array-total-size 'inline-unsafe)) + + ;;ARRAYP +- (push '((t) boolean #.(flags) +- "@0;type_of(#0)==t_array|| +-type_of(#0)==t_vector|| +-type_of(#0)==t_string|| +-type_of(#0)==t_bitvector") +- (get 'arrayp 'inline-always)) ++;; (push '((t) boolean #.(flags) ++;; "@0;type_of(#0)==t_array|| ++;; type_of(#0)==t_vector|| ++;; type_of(#0)==t_string|| ++;; type_of(#0)==t_bitvector") ++;; (get 'arrayp 'inline-always)) + + ;;ATOM +- (push '((t) boolean #.(flags)"type_of(#0)!=t_cons") ++ (push '((t) boolean #.(flags)"atom(#0)") + (get 'atom 'inline-always)) + + ;;BIT-VECTOR-P + (push '((t) boolean #.(flags)"(type_of(#0)==t_bitvector)") + (get 'bit-vector-p 'inline-always)) + ++;;BIT-VECTOR-P ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_bitvector)") ++ (get 'bit-vector-p 'inline-always)) ++ ++;;HASH-TABLE-P ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_hashtable)") ++ (get 'hash-table-p 'inline-always)) ++ ++;;RANDOM-STATE-P ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_random)") ++ (get 'random-state-p 'inline-always)) ++ ++;;RANDOM-STATE-P ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_random)") ++ (get 'random-state-p 'inline-always)) ++ ++;;PACKAGEP ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_package)") ++ (get 'packagep 'inline-always)) ++ ++;;STREAMP ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_stream)") ++ (get 'streamp 'inline-always)) ++ ++;;READTABLEP ++ (push '((t) boolean #.(flags)"(type_of(#0)==t_readtable)") ++ (get 'readtablep 'inline-always)) ++ ++;;COMPOUND PREDICATES ++(dolist (l '(integerp rationalp floatp realp numberp vectorp arrayp compiled-function-p)) ++ (push ++ `((t) boolean #.(flags) ,(substitute #\_ #\- (concatenate 'string (string-downcase l) "(#0)"))) ++ (get l 'inline-always))) ++ ++ + ;;BOUNDP + (push '((t) boolean #.(flags)"(#0)->s.s_dbind!=OBJNULL") + (get 'boundp 'inline-unsafe)) +@@ -739,7 +778,7 @@ type_of(#0)==t_bitvector") + (get 'cons 'inline-always)) + + ;;CONSP +- (push '((t) boolean #.(flags)"type_of(#0)==t_cons") ++ (push '((t) boolean #.(flags)"consp(#0)") + (get 'consp 'inline-always)) + + ;;COS +@@ -832,9 +871,9 @@ type_of(#0)==t_bitvector") + (get 'float 'inline-always)) + + ;;FLOATP +- (push '((t) boolean #.(flags) +- "@0;type_of(#0)==t_shortfloat||type_of(#0)==t_longfloat") +- (get 'floatp 'inline-always)) ++ ;; (push '((t) boolean #.(flags) ++ ;; "@0;type_of(#0)==t_shortfloat||type_of(#0)==t_longfloat") ++ ;; (get 'floatp 'inline-always)) + + ;;CEILING + (push '((t t) t #.(compiler::flags) "immnum_ceiling(#0,#1)") (get 'ceiling 'compiler::inline-always)) +@@ -861,9 +900,9 @@ type_of(#0)==t_bitvector") + (get 'get 'inline-always)) + + ;;INTEGERP +- (push '((t) boolean #.(flags) +- "@0;type_of(#0)==t_fixnum||type_of(#0)==t_bignum") +- (get 'integerp 'inline-always)) ++ ;; (push '((t) boolean #.(flags) ++ ;; "@0;type_of(#0)==t_fixnum||type_of(#0)==t_bignum") ++ ;; (get 'integerp 'inline-always)) + (push '((fixnum) boolean #.(flags) + "1") + (get 'integerp 'inline-always)) +@@ -940,7 +979,7 @@ type_of(#0)==t_bitvector") + (get 'list* 'inline-always)) + + ;;LISTP +- (push '((t) boolean #.(flags)"@0;type_of(#0)==t_cons||(#0)==Cnil") ++ (push '((t) boolean #.(flags)"listp(#0)") + (get 'listp 'inline-always)) + + ;;si::spice-p +@@ -1082,14 +1121,14 @@ type_of(#0)==t_bitvector") + (get 'null 'inline-always)) + + ;;NUMBERP +- (push '((t) boolean #.(flags) +- "@0;type_of(#0)==t_fixnum|| +-type_of(#0)==t_bignum|| +-type_of(#0)==t_ratio|| +-type_of(#0)==t_shortfloat|| +-type_of(#0)==t_longfloat|| +-type_of(#0)==t_complex") +- (get 'numberp 'inline-always)) ++;; (push '((t) boolean #.(flags) ++;; "@0;type_of(#0)==t_fixnum|| ++;; type_of(#0)==t_bignum|| ++;; type_of(#0)==t_ratio|| ++;; type_of(#0)==t_shortfloat|| ++;; type_of(#0)==t_longfloat|| ++;; type_of(#0)==t_complex") ++;; (get 'numberp 'inline-always)) + + ;;PLUSP + (push '((t) boolean #.(flags) "immnum_plusp(#0)");"number_compare(small_fixnum(0),#0)<0" +@@ -1175,7 +1214,7 @@ type_of(#0)==t_complex") + (get 'si::pathname-designatorp 'inline-always)) + + ;;PATHNAMEP +-(push '((t) boolean #.(flags)"pathnamep(#0)") ++(push '((t) boolean #.(flags)"type_of(#0)==t_pathname") + (get 'pathnamep 'inline-always)) + + ;;STRINGP +@@ -1235,11 +1274,11 @@ type_of(#0)==t_complex") + + + ;;VECTORP +- (push '((t) boolean #.(flags) +- "@0;type_of(#0)==t_vector|| +-type_of(#0)==t_string|| +-type_of(#0)==t_bitvector") +- (get 'vectorp 'inline-always)) ++;; (push '((t) boolean #.(flags) ++;; "@0;type_of(#0)==t_vector|| ++;; type_of(#0)==t_string|| ++;; type_of(#0)==t_bitvector") ++;; (get 'vectorp 'inline-always)) + + ;;WRITE-CHAR + (push '((t) t #.(flags set) +--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp +@@ -135,7 +135,6 @@ + ;;; Pass 2 initializers. + + (si:putprop 'defun 't2defun 't2) +-(si:putprop 'defmacro 't2defmacro 't2) + (si:putprop 'declare 't2declare 't2) + (si:putprop 'defentry 't2defentry 't2) + (si:putprop 'si:putprop 't2putprop 't2) +@@ -143,7 +142,6 @@ + ;;; Pass 2 C function generators. + + (si:putprop 'defun 't3defun 't3) +-(si:putprop 'defmacro 't3defmacro 't3) + (si:putprop 'ordinary 't3ordinary 't3) + (si:putprop 'sharp-comma 't3sharp-comma 't3) + (si:putprop 'clines 't3clines 't3) +@@ -205,26 +203,20 @@ + (let ((new (copy-seq str))) + (dash-to-underscore-int new 0 (length new)))) + +-(defun init-name (p &optional sp (gp t) (dc t) (nt t)) + +- (cond ((not sp) "code") +- ((not (pathnamep p)) (init-name (pathname p) sp gp dc nt)) +- (gp (init-name (truename (merge-pathnames p #p".lsp")) sp nil dc nt)) +- ((pathname-type p) +- (init-name (make-pathname +- :host (pathname-host p) +- :device (pathname-device p) +- :directory (pathname-directory p) +- :name (pathname-name p) +- :version (pathname-version p)) sp gp dc nt)) +-; #-aosvs(dc (string-downcase (init-name p sp gp nil nt))) +- ((and nt +- (let* ((pn (pathname-name p)) +- (pp (make-pathname :name pn))) +- (and (not (equal pp p)) +- (eql 4 (string<= "gcl_" pn)) +- (init-name pp sp gp dc nil))))) +- ((dash-to-underscore (namestring p))))) ++(defun init-name (p &optional sp) ++ ++ (if sp ++ (let* ((p (truename (merge-pathnames p #p".lsp"))) ++ (pn (pathname-name p)) ++ (g (zerop (si::string-match #v"^gcl_" pn)))) ++ (dash-to-underscore ++ (namestring ++ (make-pathname :host (unless g (pathname-host p)) ++ :device (unless g (pathname-device p)) ++ :directory (unless g (pathname-directory p)) ++ :name pn)))) ++ "code")) + + ;; FIXME consider making this a macro + (defun c-function-name (prefix num fname) +@@ -469,7 +461,7 @@ + (too-few-args 'defun 2 (length args))) + (cmpck (not (symbolp (car args))) + "The function name ~s is not a symbol." (car args)) +- (maybe-eval nil (cons 'defun args)) ++ (unless (macro-function (car args)) (maybe-eval nil (cons 'defun args))) + (tagbody + top + (setq *non-package-operation* t) +@@ -615,8 +607,9 @@ + (setq type (f-type (pop args)))))) + + +-(defun wt-if-proclaimed (fname cfun lambda-expr) +- (cond ((fast-link-proclaimed-type-p fname) ++(defun wt-if-proclaimed (fname cfun lambda-expr macro-p) ++ (cond (macro-p (add-init `(si::MM ',fname ,(add-address (c-function-name "LI" cfun fname))))) ++ ((fast-link-proclaimed-type-p fname) + (cond ((unless (member '* (get fname 'proclaimed-arg-types)) (assoc fname *inline-functions*)) + (add-init `(si::mfsfun ',fname ,(add-address (c-function-name "LI" cfun fname)) + ,(proclaimed-argd (get fname 'proclaimed-arg-types) +@@ -698,11 +691,11 @@ + (defun si::add-debug (fname x) + (si::putprop fname x 'si::debugger)) + +-(defun t3init-fun (fname cfun lambda-expr doc) ++(defun t3init-fun (fname cfun lambda-expr doc macro-p) + + (when doc (add-init `(si::putprop ',fname ,doc 'si::function-documentation))) + +- (cond ((wt-if-proclaimed fname cfun lambda-expr)) ++ (cond ((wt-if-proclaimed fname cfun lambda-expr macro-p)) + ((vararg-p fname) + (let ((keyp (ll-keywords-p (lambda-list lambda-expr)))) + ; (wt-h "static object LI" cfun "();") +@@ -724,6 +717,7 @@ + (add-init `(si::mf ',fname ,(add-address (c-function-name "" cfun fname))))))) + + (defun t3defun (fname cfun lambda-expr doc sp &aux inline-info ++ (macro-p (equal `(mflag ,fname) (cadr (member *current-form* *top-level-forms*)))) + (*current-form* (list 'defun fname)) + (*volatile* (volatile (second lambda-expr))) + *downward-closures*) +@@ -736,9 +730,9 @@ + (return (setq inline-info v)))) + + ;;; Add global entry information. +- (when (not (fast-link-proclaimed-type-p fname)) +- (push (list fname cfun (cadr inline-info) (caddr inline-info)) +- *global-entries*)) ++ (unless (or macro-p (fast-link-proclaimed-type-p fname)) ++ (push (list fname cfun (cadr inline-info) (caddr inline-info)) ++ *global-entries*)) + + ;;; Local entry + (analyze-regs (cadr lambda-expr) 0) +@@ -761,7 +755,7 @@ + + (wt-downward-closure-macro cfun) + +- (t3init-fun fname cfun lambda-expr doc) ++ (t3init-fun fname cfun lambda-expr doc macro-p) + + (add-debug-info fname lambda-expr)) + +@@ -1333,63 +1327,13 @@ + (long-float "double ") + (otherwise "object "))) + +- +-(defun t1defmacro (args) +- (when (or (endp args) (endp (cdr args))) +- (too-few-args 'defmacro 2 (length args))) +- (cmpck (not (symbolp (car args))) +- "The macro name ~s is not a symbol." (car args)) +- (maybe-eval t (cons 'defmacro args)) +- (setq *non-package-operation* t) +- (let ((*vars* nil) (*funs* nil) (*blocks* nil) (*tags* nil) +- (*sharp-commas* nil) (*special-binding* nil) +- macro-lambda (cfun (next-cfun))) +- (setq macro-lambda (c1dm (car args) (cadr args) (cddr args))) +- (add-load-time-sharp-comma) +- (push (list 'defmacro (car args) cfun (cddr macro-lambda) +- (car macro-lambda) ;doc +- (cadr macro-lambda) ; ppn +- *special-binding*) +- *top-level-forms*)) +- ) +- +- +-(defun t2defmacro (fname cfun macro-lambda doc ppn sp) +- +- (declare (ignore macro-lambda doc ppn sp)) +- (wt-h "static void " (c-function-name "L" cfun fname) "();") +- ) +- +-(defun t3defmacro (fname cfun macro-lambda doc ppn sp +- &aux (*volatile* (if (get fname 'contains-setjmp) +- " VOL " ""))) +- (let-pass3 +- ((*exit* 'return)) +- (wt-comment "macro definition for " fname) +- (wt-nl1 "static void " (c-function-name "L" cfun fname) "()") +- (wt-nl1 "{register object *" *volatile* "base=vs_base;") +- (assign-down-vars (nth 4 macro-lambda) cfun ;*dm-info* +- 't3defun) +- (wt-nl "register object *"*volatile* "sup=base+VM" *reservation-cmacro* ";") +- (wt " VC" *reservation-cmacro*) +- (if *safe-compile* +- (wt-nl "vs_reserve(VM" *reservation-cmacro* ");") +- (wt-nl "vs_check;")) +- (when sp (wt-nl "bds_check;")) +- (when *compiler-push-events* (wt-nl "ihs_check;")) +- (c2dm (car macro-lambda) (cadr macro-lambda) (caddr macro-lambda) +- (cadddr macro-lambda)) +- (wt-nl1 "}") +- (push (cons *reservation-cmacro* *max-vs*) *reservations*) +- (wt-h "#define VC" *reservation-cmacro*) +- (wt-cvars) +- +- (when doc (add-init `(si::putprop ',fname ,doc 'si::function-documentation) )) +- (when ppn +- (add-init `(si::putprop ',fname ',ppn 'si::pretty-print-format) )) +- (add-init `(si::MM ',fname ,(add-address (c-function-name "L" cfun fname))) ) +- +- )) ++(defun t1defmacro (args &aux (w args)(n (pop args))(l (symbol-plist n)) ++ (macp (when (listp n) (eq 'macro (car n))))(n (if macp (cdr n) n))) ++ (proclaim `(ftype (function (t t) t) ,n)) ++ (maybe-eval (not (macro-function n)) (cons 'defmacro w));FIXME? ++ (t1expr `(defun ,n ,@(if macp args (cddr (caddr (si::defmacro* n (pop args) args)))))) ++ (setf (symbol-plist n) l) ++ (push `(mflag ,n) *top-level-forms*)) + + (defun t1ordinary (form &aux tem ) + (setq *non-package-operation* t) +--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp +@@ -180,33 +180,27 @@ + (or (member-if (lambda (x) (when (consp x) (eq (car x) fname))) *funs*) + (macro-function fname)))) + +-(defun do-macro-expansion (how form &aux env) +- (dolist (v *funs*) ++(defun macro-env (&aux env) ++ (dolist (v *funs* (when env (list nil (nreverse env) nil))) + (when (consp v) +- (push (list (car v) 'macro (cadr v)) env))) +- (when env (setq env (list nil (nreverse env) nil))) +- (let ((x (multiple-value-list (cmp-toplevel-eval `(,@how ',form ',env))))) +- (if (car x) +- (let ((*print-case* :upcase)) +- (incf *error-count*) +- (print-current-form) +- (format t ";;; The macro form ~s was not expanded successfully.~%" form) +- `(error "Macro-expansion of ~s failed at compile time." ',form)) +- (cadr x)))) ++ (push (list (car v) 'macro (cadr v)) env)))) + + (defun cmp-macroexpand (form) + (if (macro-def-p form) +- (do-macro-expansion '(macroexpand) form) ++ (macroexpand form (macro-env)) + form)) + + (defun cmp-macroexpand-1 (form) + (if (macro-def-p form) +- (do-macro-expansion '(macroexpand-1) form) ++ (macroexpand-1 form (macro-env)) + form)) + + (defun cmp-expand-macro (fd fname args &aux (form (cons fname args))) + (if (macro-def-p form) +- (do-macro-expansion `(funcall *macroexpand-hook* ',fd) form) ++ (let ((env (macro-env))) ++ (if (eq *macroexpand-hook* 'funcall) ++ (funcall fd form env) ++ (funcall *macroexpand-hook* fd form env))) + form)) + + (defvar *compiler-break-enable* nil) +--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp ++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp +@@ -2,24 +2,116 @@ + (COMMON-LISP::IN-PACKAGE "COMPILER") + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::T) +- COMPILER::MLIN)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ COMPILER::TAG-REF-CLB COMPILER::SET-TOP ++ COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1LIST-NTH ++ COMPILER::C1RPLACA-NTHCDR COMPILER::C1DEFINE-STRUCTURE ++ COMPILER::BLK-REF-CLB COMPILER::WT-VV COMPILER::C1LENGTH ++ COMPILER::C1MAPC COMPILER::C1LOCAL-CLOSURE ++ COMPILER::CHECK-VREF COMPILER::WT-VAR-DECL COMPILER::C1TAGBODY ++ COMPILER::BLK-REF-CCB COMPILER::C1LOAD-TIME-VALUE ++ COMPILER::C1ASH COMPILER::FUN-LEVEL COMPILER::COPY-INFO ++ COMPILER::INLINE-POSSIBLE COMPILER::WT-VS-BASE ++ COMPILER::T1DEFENTRY COMPILER::CHARACTER-LOC-P ++ COMPILER::C2RPLACA COMPILER::RESET-INFO-TYPE ++ COMPILER::TYPE-FILTER COMPILER::TAG-SWITCH ++ COMPILER::DECL-BODY-SAFETY COMPILER::C1AND ++ COMPILER::C1FMLA-CONSTANT COMPILER::C2GO-CLB ++ COMPILER::C1FUNCTION COMPILER::C1MAPLIST COMPILER::VAR-TYPE ++ COMPILER::CLINK COMPILER::UNWIND-NO-EXIT COMPILER::VAR-LOC ++ COMPILER::C2RPLACD COMPILER::VERIFY-DATA-VECTOR ++ COMPILER::TAG-REF-CCB COMPILER::C1RETURN-FROM ++ COMPILER::T1DEFINE-STRUCTURE COMPILER::MDELETE-FILE ++ COMPILER::OBJECT-TYPE COMPILER::WT-CAR COMPILER::TAG-P ++ COMPILER::ADD-LOOP-REGISTERS COMPILER::C1MEMQ ++ COMPILER::C2FUNCTION COMPILER::CMP-MACRO-FUNCTION ++ COMPILER::C1BOOLE-CONDITION COMPILER::REP-TYPE COMPILER::C2GET ++ COMPILER::C2VAR COMPILER::C2EXPR* COMPILER::C1ADD-GLOBALS ++ COMPILER::WT1 COMPILER::C1BLOCK COMPILER::C1MAPL ++ COMPILER::C1MAPCAR COMPILER::FSET-FN-NAME COMPILER::C2GO-CCB ++ COMPILER::T1DEFLA COMPILER::C1NTH-CONDITION ++ COMPILER::ADD-OBJECT2 COMPILER::VAR-NAME COMPILER::C1EXPR ++ COMPILER::FUN-REF COMPILER::SCH-LOCAL-FUN ++ COMPILER::FIXNUM-LOC-P COMPILER::BLK-VAR ++ COMPILER::C1UNWIND-PROTECT COMPILER::C2BIND ++ COMPILER::PARSE-CVSPECS COMPILER::C1NTH ++ COMPILER::WT-SWITCH-CASE SYSTEM::UNDEF-COMPILER-MACRO ++ COMPILER::SET-UP-VAR-CVS COMPILER::C1ECASE ++ COMPILER::C1STRUCTURE-REF COMPILER::FUN-INFO ++ COMPILER::C1MEMBER COMPILER::C1GET COMPILER::WT-FUNCTION-LINK ++ COMPILER::C1ASH-CONDITION COMPILER::WT-CCB-VS COMPILER::INFO-P ++ COMPILER::REGISTER COMPILER::TAG-VAR COMPILER::C1VAR ++ COMPILER::C1TERPRI COMPILER::LTVP ++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1MAPCON ++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1SETQ ++ COMPILER::C2DOWNWARD-FUNCTION COMPILER::T3ORDINARY ++ COMPILER::C1VREF COMPILER::WT-VS COMPILER::CONSTANT-FOLD-P ++ COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-EXIT ++ COMPILER::T1DEFUN COMPILER::C1LABELS COMPILER::C1FSET ++ COMPILER::T1MACROLET COMPILER::FUN-NAME COMPILER::C1APPLY ++ COMPILER::FUN-P COMPILER::WT-DATA-PACKAGE-OPERATION ++ COMPILER::C1FUNOB COMPILER::WT-SYMBOL-FUNCTION ++ COMPILER::GET-RETURN-TYPE COMPILER::ADD-CONSTANT ++ COMPILER::SAFE-SYSTEM COMPILER::BLK-VALUE-TO-GO ++ COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C2TAGBODY-LOCAL ++ COMPILER::C1DECLARE COMPILER::C1OR COMPILER::C1ASSOC ++ COMPILER::ADD-ADDRESS COMPILER::VAR-KIND ++ COMPILER::PROCLAMATION COMPILER::FIX-OPT COMPILER::WT-DATA1 ++ COMPILER::INFO-SP-CHANGE COMPILER::ARGS-CAUSE-SIDE-EFFECT ++ COMPILER::WRITE-BLOCK-OPEN COMPILER::C2TAGBODY-BODY ++ COMPILER::CONS-TO-LISTA COMPILER::SAVE-FUNOB COMPILER::VAR-REF ++ COMPILER::C1LOCAL-FUN COMPILER::VAR-REP-LOC ++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::CTOP-WRITE ++ COMPILER::C2TAGBODY-CLB COMPILER::T1CLINES ++ COMPILER::ADD-OBJECT COMPILER::GET-LOCAL-RETURN-TYPE ++ COMPILER::DEFAULT-INIT COMPILER::FUNCTION-ARG-TYPES ++ COMPILER::C1STRUCTURE-SET COMPILER::CMP-MACROEXPAND-1 ++ COMPILER::INLINE-TYPE COMPILER::VAR-REGISTER ++ COMPILER::DECLARATION-TYPE COMPILER::C1CATCH COMPILER::C1LET ++ COMPILER::T3CLINES COMPILER::UNDEFINED-VARIABLE COMPILER::C1GO ++ COMPILER::TAG-NAME COMPILER::SCH-GLOBAL COMPILER::C1IF ++ COMPILER::C1FLET COMPILER::INLINE-BOOLE3-STRING ++ COMPILER::INFO-CHANGED-ARRAY COMPILER::C2FUNCALL-AUX ++ COMPILER::FUN-REF-CCB COMPILER::WT-CADR COMPILER::FUN-CFUN ++ COMPILER::WT-VS* COMPILER::WT-DOWN COMPILER::C2GETHASH ++ COMPILER::ADD-REG1 COMPILER::REPLACE-CONSTANT ++ COMPILER::C2DM-RESERVE-V COMPILER::RESULT-TYPE ++ COMPILER::C1FUNCALL COMPILER::C1THE COMPILER::VARARG-P ++ COMPILER::INFO-REFERRED-ARRAY COMPILER::C1PROGV ++ COMPILER::T2DECLARE COMPILER::T1DEFCFUN COMPILER::C2VALUES ++ COMPILER::C1SWITCH COMPILER::C1MAPCAN ++ COMPILER::CMP-MACROEXPAND COMPILER::TAG-LABEL ++ COMPILER::TAG-UNWIND-EXIT COMPILER::C1PRINC COMPILER::C1THROW ++ COMPILER::SAVE-AVMA COMPILER::VOLATILE COMPILER::FLAGS-POS ++ COMPILER::INFO-TYPE COMPILER::C1NTHCDR-CONDITION ++ COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::WT-FUNCALL-C ++ COMPILER::PUSH-ARGS COMPILER::C1DM-BAD-KEY ++ COMPILER::T1ORDINARY COMPILER::C1PSETQ COMPILER::BLK-REF ++ COMPILER::C2DM-RESERVE-VL COMPILER::C1MACROLET ++ COMPILER::C1SHARP-COMMA COMPILER::C1RPLACA ++ COMMON-LISP::PROCLAIM COMPILER::PUSH-DATA-INCF ++ COMPILER::MACRO-DEF-P COMPILER::BLK-NAME COMPILER::C1VALUES ++ COMPILER::C1DOWNWARD-FUNCTION COMPILER::T1DEFMACRO ++ COMPILER::GET-ARG-TYPES COMPILER::ADD-SYMBOL ++ COMPILER::NAME-SD1 COMPILER::C2GO-LOCAL ++ COMPILER::C2TAGBODY-CCB COMPILER::WT-LIST ++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::C1BOOLE3 ++ COMPILER::C1STACK-LET COMPILER::WT-CDR COMPILER::C1QUOTE ++ COMPILER::C1EVAL-WHEN COMPILER::VAR-P COMPILER::CHECK-DOWNWARD ++ COMPILER::T1PROGN COMPILER::BLK-P COMPILER::C2LOCATION ++ COMPILER::THE-PARAMETER COMPILER::C2VAR-KIND ++ COMPILER::C1GETHASH COMPILER::LTVP-EVAL COMPILER::C1RPLACD ++ COMPILER::INFO-VOLATILE COMPILER::LONG-FLOAT-LOC-P ++ COMPILER::FUNCTION-RETURN-TYPE COMPILER::SHORT-FLOAT-LOC-P ++ COMPILER::WT-H1 COMPILER::C1MULTIPLE-VALUE-CALL ++ COMPILER::NAME-TO-SD COMPILER::C1PROGN COMPILER::SET-RETURN ++ COMPILER::C1LET* COMPILER::AET-C-TYPE COMPILER::C1COMPILER-LET ++ COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::VV-STR ++ COMPILER::C1NTHCDR COMPILER::TAG-REF COMPILER::GET-INCLUDED)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::T) +- COMPILER::DASH-TO-UNDERSCORE-INT)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ COMPILER::INLINE-BOOLE3)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -29,332 +121,93 @@ + COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- COMPILER::C1NIL COMPILER::WT-DATA-FILE +- COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-NEXT-VAR-ARG +- COMPILER::RESET-TOP COMPILER::VS-PUSH COMPILER::BABOON +- COMPILER::GAZONK-NAME COMPILER::PRINT-COMPILER-INFO +- COMPILER::ADD-LOAD-TIME-SHARP-COMMA COMPILER::INIT-ENV +- COMPILER::PRINT-CURRENT-FORM COMPILER::WT-C-PUSH COMPILER::C1T +- COMPILER::WT-FIRST-VAR-ARG COMPILER::CCB-VS-PUSH +- COMPILER::INC-INLINE-BLOCKS COMPILER::WT-CVARS +- COMPILER::WT-FASD-DATA-FILE COMPILER::WFS-ERROR +- COMPILER::WT-DATA-END COMPILER::TAIL-RECURSION-POSSIBLE +- COMPILER::CVS-PUSH COMPILER::WT-DATA-BEGIN)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::FIXNUM) +- COMPILER::ANALYZE-REGS1 COMPILER::ANALYZE-REGS +- COMPILER::PROCLAIMED-ARGD)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::CHECK-FNAME-ARGS COMPILER::COERCE-LOC +- COMPILER::TYPE>= COMPILER::C2BIND-LOC +- COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::ADD-DEBUG-INFO +- COMPILER::MAKE-USER-INIT COMPILER::CO1EQL COMPILER::C2ASSOC!2 +- COMPILER::WT-VAR COMPILER::CFAST-WRITE COMPILER::C2STACK-LET +- COMPILER::C2DM-BIND-INIT COMPILER::IS-REP-REFERRED +- COMPILER::CO1CONS COMPILER::SHIFT<< +- COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2CALL-LOCAL +- COMPILER::CO1SCHAR COMPILER::C1CONSTANT-VALUE +- COMPILER::WT-CHARACTER-VALUE COMPILER::CONVERT-CASE-TO-SWITCH +- COMPILER::C2MULTIPLE-VALUE-CALL COMPILER::C2EXPR-TOP +- COMPILER::CO1READ-BYTE COMPILER::PRIN1-CMP +- COMPILER::STRUCT-TYPE-OPT COMPILER::C1DECL-BODY +- COMPILER::COERCE-LOC-STRUCTURE-REF +- COMPILER::CO1STRUCTURE-PREDICATE COMPILER::WT-MAKE-DCLOSURE +- COMPILER::ARGS-INFO-CHANGED-VARS +- COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::CO1LDB +- COMPILER::CO1WRITE-BYTE COMPILER::C1PROGN* +- COMPILER::CO1CONSTANT-FOLD COMPILER::SET-JUMP-TRUE +- COMPILER::C1SETQ1 COMPILER::CO1READ-CHAR COMPILER::C2BIND-INIT +- COMPILER::CO1TYPEP COMPILER::WT-FIXNUM-VALUE +- COMPILER::MULTIPLE-VALUE-CHECK COMPILER::SHIFT>> +- COMPILER::CO1SUBLIS COMPILER::DO-MACRO-EXPANSION +- COMPILER::C2UNWIND-PROTECT COMPILER::C2CALL-LAMBDA +- COMPILER::C2MEMBER!2 COMPILER::GET-INLINE-LOC +- COMPILER::C1LAMBDA-FUN COMPILER::JUMPS-TO-P COMPILER::C1EXPR* +- COMPILER::C2SETQ COMPILER::C2APPLY COMPILER::UNWIND-BDS +- COMPILER::SET-BDS-BIND COMPILER::NEED-TO-PROTECT +- COMPILER::C1FMLA COMPILER::TYPE-AND COMPILER::CMPFIX-ARGS +- COMPILER::MAYBE-EVAL COMPILER::C2BLOCK-CLB COMPILER::SET-DBIND +- COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY +- COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2DM-BIND-VL +- COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::T3SHARP-COMMA +- COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES COMPILER::C2CATCH +- COMPILER::C2EXPR-TOP* COMPILER::SET-JUMP-FALSE +- COMPILER::CO1VECTOR-PUSH COMPILER::WT-V*-MACROS +- COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-VS +- COMPILER::WT-REQUIREDS COMPILER::C2RETURN-CCB +- COMPILER::C2THROW COMPILER::CHECK-END +- COMPILER::PUSH-CHANGED-VARS COMPILER::C2BLOCK-CCB +- SYSTEM::ADD-DEBUG COMPILER::C2PSETQ COMPILER::C1ARGS +- COMPILER::COMPILER-CC COMPILER::INLINE-PROC +- COMPILER::CO1WRITE-CHAR COMPILER::COMPILER-DEF-HOOK +- COMPILER::CAN-BE-REPLACED COMPILER::C2MULTIPLE-VALUE-PROG1 +- COMPILER::C2DM-BIND-LOC COMPILER::ADD-INFO +- COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2LAMBDA-EXPR-WITH-KEY +- COMPILER::FAST-READ COMPILER::C2RETURN-CLB +- COMPILER::PROCLAIM-VAR)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMPILER::COMPILE-FILE1)) ++ COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::WT-IF-PROCLAIMED ++ COMPILER::MY-CALL COMPILER::WT-GLOBAL-ENTRY ++ COMPILER::T3DEFUN-NORMAL COMPILER::C2STRUCTURE-REF ++ COMPILER::C2SWITCH COMPILER::C2CALL-GLOBAL ++ COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::MAKE-INLINE-STRING COMPILER::GET-INLINE-INFO +- COMPILER::C1STRUCTURE-REF1 COMPILER::CJF COMPILER::SET-VAR +- COMPILER::CHECK-FORM-TYPE COMPILER::AND-FORM-TYPE +- COMPILER::SUBLIS1-INLINE COMPILER::T3DEFCFUN +- COMPILER::WT-INLINE-INTEGER COMPILER::C-FUNCTION-NAME +- COMPILER::FIX-DOWN-ARGS COMPILER::ASSIGN-DOWN-VARS +- COMPILER::WT-INLINE-FIXNUM COMPILER::C2GO COMPILER::CJT +- COMPILER::TOO-FEW-ARGS COMPILER::C2PRINC COMPILER::C2CASE +- COMPILER::C2LET* COMPILER::BOOLE3 COMPILER::COMPILER-PASS2 +- COMPILER::C1DM COMPILER::CHECK-VDECL COMPILER::C2LET +- COMPILER::MYSUB COMPILER::CAN-BE-REPLACED* +- COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::WT-IF-PROCLAIMED +- COMPILER::C1MAP-FUNCTIONS COMPILER::ADD-FAST-LINK +- COMPILER::WT-INLINE-LONG-FLOAT COMPILER::TOO-MANY-ARGS +- COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2PROGV +- COMPILER::WT-INLINE-CHARACTER +- COMPILER::ADD-FUNCTION-DECLARATION COMPILER::CMP-EXPAND-MACRO +- COMPILER::C2MAPCAR COMPILER::INLINE-TYPE-MATCHES +- COMPILER::C2FUNCALL-SFUN COMPILER::WT-MAKE-CCLOSURE +- COMPILER::C2MAPCAN COMPILER::C2TAGBODY +- COMPILER::WT-INLINE-COND COMPILER::C2MAPC +- COMPILER::WT-INLINE-SHORT-FLOAT)) ++ COMPILER::LINK COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL ++ COMPILER::INLINE-ARGS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) ++ COMPILER::WT-INLINE-INTEGER COMPILER::ADD-FUNCTION-DECLARATION ++ COMPILER::C1STRUCTURE-REF1 COMPILER::ADD-FAST-LINK ++ COMPILER::AND-FORM-TYPE COMPILER::C2PRINC COMPILER::C2MAPCAN ++ COMPILER::CJT COMPILER::C2CASE COMPILER::WT-INLINE-LONG-FLOAT ++ COMPILER::SUBLIS1-INLINE COMPILER::MYSUB ++ COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::FIX-DOWN-ARGS ++ COMPILER::TOO-MANY-ARGS COMPILER::CMP-EXPAND-MACRO ++ COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2GO ++ COMPILER::WT-INLINE-FIXNUM COMPILER::WT-INLINE-COND ++ COMPILER::C1MAP-FUNCTIONS COMPILER::C1DM ++ COMPILER::WT-MAKE-CCLOSURE COMPILER::CAN-BE-REPLACED* ++ COMPILER::C-FUNCTION-NAME COMPILER::C2LET* COMPILER::CJF ++ COMPILER::TOO-FEW-ARGS COMPILER::BOOLE3 COMPILER::T3DEFCFUN ++ COMPILER::C2FUNCALL-SFUN COMPILER::C2MAPC ++ COMPILER::CHECK-FORM-TYPE COMPILER::SET-VAR ++ COMPILER::C2TAGBODY COMPILER::CHECK-VDECL ++ COMPILER::GET-INLINE-INFO COMPILER::ASSIGN-DOWN-VARS ++ COMPILER::C2LET COMPILER::INLINE-TYPE-MATCHES ++ COMPILER::COMPILER-PASS2 COMPILER::C2PROGV COMPILER::C2MAPCAR ++ COMPILER::MAKE-INLINE-STRING COMPILER::WT-INLINE-CHARACTER ++ COMPILER::WT-INLINE-SHORT-FLOAT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY COMPILER::T2DEFENTRY +- COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO)) ++ COMPILER::T2DEFENTRY COMPILER::DEFSYSFUN COMPILER::T3DEFENTRY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::T3DEFUN COMPILER::T3DEFUN-LOCAL-ENTRY +- COMPILER::C2STRUCTURE-SET COMPILER::T2DEFUN ++ COMPILER::T3DEFUN-LOCAL-ENTRY COMPILER::T3INIT-FUN ++ COMPILER::T2DEFUN COMPILER::T3DEFUN COMPILER::C2STRUCTURE-SET + COMPILER::C1APPLY-OPTIMIZE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL +- COMPILER::INLINE-ARGS COMPILER::LINK)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::T) +- COMPILER::T3INIT-FUN COMPILER::C2STRUCTURE-REF +- COMPILER::WT-GLOBAL-ENTRY COMPILER::T3DEFUN-NORMAL +- COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR +- COMPILER::C2SWITCH COMPILER::MY-CALL COMPILER::C2CALL-GLOBAL +- COMPILER::C2CALL-UNKNOWN-GLOBAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::T) + COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(COMPILER::CMP-ANON COMMON-LISP::COMPILE COMPILER::CMP-TMP-MACRO +- COMMON-LISP::DISASSEMBLE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- COMPILER::MAKE-VAR COMPILER::COMPILER-COMMAND +- COMPILER::LIST*-INLINE COMMON-LISP::COMPILE-FILE +- COMPILER::CS-PUSH COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE +- COMPILER::C2FSET COMPILER::MAKE-TAG COMPILER::WT-CLINK +- COMPILER::LIST-INLINE COMPILER::MAKE-FUN COMPILER::MAKE-BLK)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- COMPILER::T1EVAL-WHEN COMPILER::T1EXPR +- COMPILER::WT-CHARACTER-LOC COMPILER::SET-LOC +- COMPILER::CMP-TOPLEVEL-EVAL COMPILER::C2PROGN +- COMPILER::WT-TO-STRING COMPILER::MEXPAND-DEFTYPE +- COMPILER::WT-SHORT-FLOAT-LOC COMPILER::CMP-EVAL +- COMPILER::WT-LOC COMPILER::C2AND COMPILER::C2EXPR +- COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2OR +- COMPILER::WT-FIXNUM-LOC)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- COMPILER::LTVP-EVAL COMPILER::FSET-FN-NAME COMPILER::C1MAPCON +- COMPILER::FUNCTION-ARG-TYPES COMPILER::C1SHARP-COMMA +- COMPILER::SAVE-AVMA COMPILER::C2TAGBODY-CCB COMPILER::VAR-LOC +- COMPILER::WT-DOWN COMPILER::C1SETQ COMPILER::TAG-REF-CCB +- COMPILER::T1DEFINE-STRUCTURE COMPILER::SAVE-FUNOB +- COMPILER::C1VAR COMPILER::VV-STR COMPILER::C1RPLACA +- COMPILER::INFO-SP-CHANGE COMPILER::BLK-REF-CCB +- COMPILER::T1ORDINARY COMPILER::FIXNUM-LOC-P +- COMPILER::FUN-REF-CCB COMPILER::C2GET COMPILER::FUN-NAME +- COMPILER::FUN-P COMPILER::SCH-GLOBAL COMPILER::C1LET +- COMPILER::C2TAGBODY-CLB COMPILER::C1UNWIND-PROTECT +- COMPILER::SET-RETURN COMPILER::WT-VAR-DECL +- COMPILER::VAR-REGISTER COMPILER::C1DEFINE-STRUCTURE +- COMPILER::LTVP COMPILER::INLINE-POSSIBLE COMPILER::CHECK-VREF +- COMPILER::TAG-NAME COMPILER::C2DM-RESERVE-VL +- COMPILER::VAR-TYPE COMPILER::WT-LIST COMPILER::C1LET* +- COMPILER::VARARG-P COMPILER::C1LOAD-TIME-VALUE +- COMPILER::C2FUNCALL-AUX COMPILER::INFO-TYPE COMPILER::C1GET +- COMPILER::C1NTHCDR-CONDITION COMPILER::C1AND +- COMPILER::C1MULTIPLE-VALUE-CALL COMPILER::C1RPLACA-NTHCDR +- COMPILER::INFO-VOLATILE COMPILER::INLINE-TYPE +- COMPILER::LONG-FLOAT-LOC-P COMPILER::INFO-CHANGED-ARRAY +- SYSTEM::UNDEF-COMPILER-MACRO COMPILER::DECL-BODY-SAFETY +- COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P COMPILER::C2BIND +- COMPILER::C1DECLARE COMPILER::CONS-TO-LISTA +- COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::NAME-SD1 +- COMPILER::BLK-NAME COMPILER::PARSE-CVSPECS COMPILER::C1MAPL +- COMPILER::AET-C-TYPE COMPILER::C2VAR COMPILER::COPY-INFO +- COMPILER::C1PSETQ COMPILER::C1VREF COMPILER::FUN-REF +- COMPILER::WT-H1 COMPILER::T1DEFCFUN COMPILER::T1PROGN +- COMPILER::C1EVAL-WHEN COMPILER::FLAGS-POS COMPILER::WT-VS +- COMPILER::C2VAR-KIND COMPILER::C1LENGTH +- COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C2LOCATION +- COMPILER::C2DM-RESERVE-V COMPILER::C2FUNCTION +- COMPILER::WT-SWITCH-CASE COMPILER::C2TAGBODY-LOCAL +- COMPILER::CONSTANT-FOLD-P COMPILER::NEED-TO-SET-VS-POINTERS +- COMPILER::C1MAPCAN COMPILER::WT-FUNCALL-C COMPILER::WT-CCB-VS +- COMPILER::C1RETURN-FROM COMPILER::GET-INCLUDED +- COMPILER::C1BLOCK COMPILER::ADD-CONSTANT COMPILER::WT-VS-BASE +- COMPILER::C1NTH-CONDITION COMPILER::FUN-LEVEL +- COMPILER::UNWIND-NO-EXIT COMMON-LISP::PROCLAIM +- COMPILER::C1PRINC COMPILER::C2EXPR* COMPILER::RESULT-TYPE +- COMPILER::TAG-REF COMPILER::C1FUNCALL COMPILER::C1PROGN +- COMPILER::MAXARGS COMPILER::UNDEFINED-VARIABLE COMPILER::C1THE +- COMPILER::CMP-MACROEXPAND COMPILER::C1MAPCAR +- COMPILER::DEFAULT-INIT COMPILER::C1STRUCTURE-SET +- COMPILER::WT-SYMBOL-FUNCTION COMPILER::T1DEFUN +- COMPILER::WT-DATA1 COMPILER::PUSH-DATA-INCF COMPILER::C1IF +- COMPILER::C1NTHCDR COMPILER::ADD-SYMBOL +- COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-REF +- COMPILER::WT-FUNCTION-LINK COMPILER::INFO-P COMPILER::C1FSET +- COMPILER::C1PROGV COMPILER::C1ASSOC COMPILER::VAR-REF +- COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::MDELETE-FILE +- COMPILER::CMP-MACRO-FUNCTION COMPILER::C2DOWNWARD-FUNCTION +- COMPILER::C2GO-LOCAL COMPILER::T1DEFLA COMPILER::VAR-REF-CCB +- COMPILER::C1FLET COMPILER::C1LIST-NTH +- COMPILER::ADD-LOOP-REGISTERS COMPILER::INFO-REFERRED-ARRAY +- COMPILER::BLK-VALUE-TO-GO COMPILER::WT-VS* +- COMPILER::NAME-TO-SD COMPILER::C1RPLACD +- COMPILER::WT-DATA-PACKAGE-OPERATION COMPILER::C1SWITCH +- COMPILER::C1CATCH COMPILER::WT-CAR COMPILER::C1MACROLET +- COMPILER::OBJECT-TYPE COMPILER::C1MAPC COMPILER::T1CLINES +- COMPILER::C1COMPILER-LET COMPILER::CMP-MACROEXPAND-1 +- COMPILER::C1TAGBODY COMPILER::C1MAPLIST COMPILER::PUSH-ARGS +- COMPILER::T3ORDINARY COMPILER::C1MEMBER COMPILER::T1MACROLET +- COMPILER::WT-CDR COMPILER::C1BOOLE3 COMPILER::PROCLAMATION +- COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::C1LOCAL-FUN +- COMPILER::VAR-KIND COMPILER::WT1 COMPILER::TAG-SWITCH +- COMPILER::C1OR COMPILER::C1STRUCTURE-REF +- COMPILER::THE-PARAMETER COMPILER::VAR-REP-LOC +- COMPILER::DECLARATION-TYPE COMPILER::TAG-P COMPILER::C2GETHASH +- COMPILER::C1EXPR COMPILER::REPLACE-CONSTANT COMPILER::C1ECASE +- COMPILER::FUN-CFUN COMPILER::SET-TOP COMPILER::TAG-LABEL +- COMPILER::C1DM-BAD-KEY COMPILER::C1THROW COMPILER::C2GO-CCB +- COMPILER::REP-TYPE COMPILER::C2VALUES +- COMPILER::SHORT-FLOAT-LOC-P COMPILER::FUNCTION-RETURN-TYPE +- COMPILER::ADD-OBJECT COMPILER::CTOP-WRITE COMPILER::C1MEMQ +- COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1TERPRI +- COMPILER::T1DEFMACRO COMPILER::T3CLINES COMPILER::ADD-REG1 +- COMPILER::C1NTH COMPILER::C1ASH COMPILER::C1FMLA-CONSTANT +- COMPILER::C2GO-CLB COMPILER::WT-CADR +- COMPILER::C1BOOLE-CONDITION COMPILER::CLINK COMPILER::VAR-NAME +- COMPILER::PUSH-ARGS-LISPCALL COMPILER::GET-ARG-TYPES +- COMPILER::BLK-VAR COMPILER::C1APPLY COMPILER::CHECK-DOWNWARD +- COMPILER::C1QUOTE COMPILER::TAG-REF-CLB +- COMPILER::GET-LOCAL-ARG-TYPES COMPILER::REGISTER +- COMPILER::BLK-P COMPILER::FUN-INFO COMPILER::C2RPLACD +- COMPILER::ADD-OBJECT2 COMPILER::C2TAGBODY-BODY +- COMPILER::T1DEFENTRY COMPILER::C1FUNCTION +- COMPILER::C1DOWNWARD-FUNCTION COMPILER::SAFE-SYSTEM +- COMPILER::C1GO COMPILER::BLK-EXIT COMPILER::VERIFY-DATA-VECTOR +- COMPILER::C2RPLACA COMPILER::T2DECLARE COMPILER::MACRO-DEF-P +- COMPILER::C1LABELS COMPILER::C1GETHASH COMPILER::FIX-OPT +- COMPILER::SCH-LOCAL-FUN COMPILER::C1FUNOB +- COMPILER::SET-PUSH-CATCH-FRAME COMPILER::GET-RETURN-TYPE +- COMPILER::SET-UP-VAR-CVS COMPILER::TAG-UNWIND-EXIT +- COMPILER::VAR-P COMPILER::C1ADD-GLOBALS COMPILER::TYPE-FILTER +- COMPILER::WT-VV COMPILER::C1ASH-CONDITION COMPILER::VOLATILE +- COMPILER::INLINE-BOOLE3-STRING COMPILER::C1LOCAL-CLOSURE +- COMPILER::WRITE-BLOCK-OPEN COMPILER::ADD-ADDRESS +- COMPILER::RESET-INFO-TYPE COMPILER::C1VALUES +- COMPILER::BLK-REF-CLB COMPILER::C1STACK-LET)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- COMPILER::INLINE-BOOLE3)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::T) +- COMPILER::MEMOIZED-HASH-EQUAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- COMPILER::WT-INLINE-LOC COMPILER::NCONC-FILES +- COMPILER::COMPILER-BUILD COMPILER::C2BLOCK-LOCAL +- COMPILER::C2DECL-BODY COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK +- COMPILER::C1BODY COMPILER::C2RETURN-LOCAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::C1LAMBDA-EXPR COMPILER::CMPWARN COMPILER::ADD-INIT +- COMPILER::UNWIND-EXIT COMPILER::CMPNOTE COMPILER::CMPERR +- COMPILER::C1CASE COMPILER::WT-COMMENT COMPILER::INIT-NAME +- COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::WT-INTEGER-LOC +- COMPILER::WT-CVAR)) ++ COMPILER::T3LOCAL-DCFUN COMPILER::T3LOCAL-FUN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) +- COMPILER::C2IF COMPILER::WT-INLINE COMPILER::C2COMPILER-LET +- COMPILER::C2FLET COMPILER::C2LABELS)) ++ COMPILER::C2LABELS COMPILER::C2FLET COMPILER::C2IF ++ COMPILER::WT-INLINE COMPILER::C2COMPILER-LET)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) +- COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE +- COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL)) ++ COMPILER::C2RETURN-FROM COMPILER::C2DM COMPILER::C1DM-VL ++ COMPILER::C2APPLY-OPTIMIZE COMPILER::C1DM-V)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -363,6 +216,36 @@ + COMPILER::T3DEFUN-AUX)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC ++ COMPILER::WT-CHARACTER-LOC COMPILER::WT-TO-STRING ++ COMPILER::WT-LOC COMPILER::MEXPAND-DEFTYPE ++ COMPILER::CMP-TOPLEVEL-EVAL COMPILER::T1EVAL-WHEN ++ COMPILER::T1EXPR COMPILER::C2OR COMPILER::WT-FIXNUM-LOC ++ COMPILER::C2EXPR COMPILER::C2AND COMPILER::CMP-EVAL ++ COMPILER::SET-LOC COMPILER::WT-SHORT-FLOAT-LOC)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE ++ COMPILER::LIST-INLINE COMPILER::LIST*-INLINE ++ COMPILER::COMPILER-COMMAND COMPILER::MAKE-BLK ++ COMPILER::MAKE-FUN COMPILER::WT-CLINK COMPILER::C2FSET ++ COMPILER::MAKE-TAG COMPILER::CS-PUSH COMPILER::MAKE-VAR ++ COMMON-LISP::COMPILE-FILE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ COMPILER::F-TYPE)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(COMMON-LISP::DISASSEMBLE COMPILER::CMP-TMP-MACRO ++ COMPILER::CMP-ANON COMMON-LISP::COMPILE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) + COMMON-LISP::T) +@@ -374,11 +257,9 @@ + (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- COMPILER::BSEARCHLEQ)) ++ COMPILER::PUSH-ARRAY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -386,10 +267,148 @@ + (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) + COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- COMPILER::PUSH-ARRAY)) ++ COMPILER::BSEARCHLEQ)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- COMPILER::F-TYPE)) +\ No newline at end of file ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ COMPILER::DASH-TO-UNDERSCORE-INT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ COMPILER::MLIN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ COMPILER::MEMOIZED-HASH-EQUAL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ COMPILER::MACRO-ENV COMPILER::C1T COMPILER::PRINT-CURRENT-FORM ++ COMPILER::CCB-VS-PUSH COMPILER::C1NIL ++ COMPILER::WT-FASD-DATA-FILE COMPILER::INIT-ENV ++ COMPILER::WT-CVARS COMPILER::CVS-PUSH ++ COMPILER::WT-FIRST-VAR-ARG COMPILER::WT-NEXT-VAR-ARG ++ COMPILER::WT-DATA-FILE COMPILER::WT-C-PUSH ++ COMPILER::GAZONK-NAME COMPILER::WT-DATA-END ++ COMPILER::INC-INLINE-BLOCKS COMPILER::TAIL-RECURSION-POSSIBLE ++ COMPILER::RESET-TOP COMPILER::CLOSE-INLINE-BLOCKS ++ COMPILER::PRINT-COMPILER-INFO COMPILER::WFS-ERROR ++ COMPILER::VS-PUSH COMPILER::BABOON COMPILER::WT-DATA-BEGIN ++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1 ++ COMPILER::ANALYZE-REGS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMPILER::UNWIND-EXIT COMPILER::WT-COMMENT COMPILER::CMPERR ++ COMPILER::WT-CVAR COMPILER::FAST-LINK-PROCLAIMED-TYPE-P ++ COMPILER::C1CASE COMPILER::CMPWARN COMPILER::ADD-INIT ++ COMPILER::INIT-NAME COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE ++ COMPILER::C1LAMBDA-EXPR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::C2BLOCK COMPILER::C1SYMBOL-FUN ++ COMPILER::C2BLOCK-LOCAL COMPILER::C2DECL-BODY ++ COMPILER::COMPILER-BUILD COMPILER::NCONC-FILES ++ COMPILER::WT-INLINE-LOC COMPILER::C2RETURN-LOCAL ++ COMPILER::C1BODY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMPILER::WT-FIXNUM-VALUE COMPILER::DOLIST** COMPILER::CO1LDB ++ COMPILER::PUSH-REFERRED-WITH-START COMPILER::C2ASSOC!2 ++ COMPILER::ADD-DEBUG-INFO COMPILER::WT-CHARACTER-VALUE ++ COMPILER::MAYBE-WT-C2DM-BIND-VL COMPILER::C2BIND-LOC ++ COMPILER::C2CATCH COMPILER::DO-REFERRED COMPILER::C2BLOCK-CLB ++ COMPILER::CO1CONSTANT-FOLD COMPILER::C2CALL-LOCAL ++ COMPILER::SHIFT<< COMPILER::C2UNWIND-PROTECT ++ COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2DM-BIND-VL ++ COMPILER::DOTIMES* COMPILER::REFERRED-LENGTH COMPILER::C1ARGS ++ COMPILER::CK-SPEC COMPILER::C2MULTIPLE-VALUE-CALL ++ COMPILER::C2CALL-LAMBDA COMPILER::CO1READ-BYTE ++ COMPILER::CO1VECTOR-PUSH COMPILER::STACK-LET COMPILER::CMPCK ++ COMPILER::MAYBE-EVAL COMPILER::COERCE-LOC COMPILER::C2PSETQ ++ SYSTEM::DEFINE-INLINE-FUNCTION COMPILER::WT-MAKE-DCLOSURE ++ COMPILER::COMPILER-CC COMPILER::WT-GO COMPILER::C1LAMBDA-FUN ++ COMPILER::C2RETURN-CLB COMPILER::C1DECL-BODY ++ COMPILER::PUSH-CHANGED-VARS COMPILER::GET-INLINE-LOC ++ COMPILER::CO1SUBLIS COMPILER::CHANGED-LENGTH COMPILER::CO1CONS ++ COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-JUMP-FALSE ++ COMPILER::MAKE-USER-INIT COMPILER::NEXT-CVAR ++ COMPILER::CAN-BE-REPLACED COMPILER::WT-V*-MACROS ++ COMPILER::NEXT-CMACRO COMPILER::C2RETURN-CCB ++ COMPILER::CO1SCHAR COMPILER::IS-CHANGED ++ COMMON-LISP::DEFINE-COMPILER-MACRO COMPILER::SET-DBIND ++ COMPILER::WT-H COMPILER::COERCE-LOC-STRUCTURE-REF ++ COMPILER::C1EXPR* COMPILER::IS-REFERRED COMPILER::SHIFT>> ++ COMPILER::WT COMPILER::TYPE-AND COMPILER::PRIN1-CMP ++ COMPILER::C2BIND-INIT COMPILER::RESULT-TYPE-FROM-ARGS ++ COMPILER::EQL-NOT-NIL COMPILER::C2APPLY COMPILER::C2BLOCK-CCB ++ COMPILER::WT-NL1 COMPILER::CO1WRITE-CHAR COMPILER::CFAST-WRITE ++ COMPILER::NEED-TO-PROTECT COMPILER::T3SHARP-COMMA ++ SYSTEM::ADD-DEBUG COMPILER::BIGNUM-EXPANSION-STORAGE ++ COMPILER::C2SETQ COMPILER::FLAG-P ++ COMPILER::PUSH-CHANGED-WITH-START COMPILER::CMPFIX-ARGS ++ COMPILER::CO1STRUCTURE-PREDICATE COMPILER::FAST-READ ++ COMPILER::C1CONSTANT-VALUE COMPILER::BASE-USED ++ COMPILER::PROCLAIM-VAR COMPILER::CO1TYPEP ++ COMPILER::SET-JUMP-TRUE COMPILER::TYPE>= COMPILER::DOTIMES** ++ COMPILER::CONVERT-CASE-TO-SWITCH COMPILER::C2MEMBER!2 ++ COMPILER::DO-CHANGED COMPILER::ADD-INFO COMPILER::SET-VS ++ COMPILER::CHECK-FNAME-ARGS ++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES ++ COMPILER::C2MULTIPLE-VALUE-PROG1 COMPILER::NEXT-LABEL* ++ COMPILER::WT-VAR COMPILER::C2THROW COMPILER::INLINE-PROC ++ COMPILER::PUSH-REFERRED COMPILER::C2LIST-NTH-IMMEDIATE ++ COMPILER::C1FMLA COMPILER::PUSH-CHANGED ++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::MIA ++ COMPILER::WT-LABEL COMPILER::WT-NL ++ COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::SET-BDS-BIND ++ COMPILER::DO-ARRAY COMPILER::WT-REQUIREDS ++ COMPILER::C2EXPR-TOP* COMPILER::C2DM-BIND-LOC ++ COMPILER::DOLIST* SYSTEM::SWITCH-FINISH ++ COMPILER::IS-REP-REFERRED COMPILER::WT-LONG-FLOAT-VALUE ++ COMPILER::C1SETQ1 COMPILER::FLAGS COMPILER::CO1EQL ++ COMPILER::CHECK-END COMPILER::NEXT-LABEL COMPILER::CK-VL ++ COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::C1PROGN* ++ COMPILER::C2DM-BIND-INIT COMPILER::STRUCT-TYPE-OPT ++ COMPILER::UNWIND-BDS COMPILER::SAFE-COMPILE ++ COMPILER::CO1READ-CHAR COMPILER::JUMPS-TO-P SYSTEM::SWITCH ++ COMPILER::NEXT-CFUN COMPILER::CO1WRITE-BYTE ++ COMPILER::DOWNWARD-FUNCTION COMPILER::COMPILER-DEF-HOOK ++ COMPILER::C2STACK-LET COMPILER::C2EXPR-TOP ++ COMPILER::C2LAMBDA-EXPR-WITH-KEY COMPILER::IN-ARRAY ++ COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMPILER::COMPILE-FILE1)) +\ No newline at end of file +--- gcl-2.6.12.orig/config.sub ++++ gcl-2.6.12/config.sub +@@ -1,8 +1,8 @@ + #! /bin/sh + # Configuration validation subroutine script. +-# Copyright 1992-2014 Free Software Foundation, Inc. ++# Copyright 1992-2015 Free Software Foundation, Inc. + +-timestamp='2014-05-01' ++timestamp='2015-08-20' + + # This file is free software; you can redistribute it and/or modify it + # under the terms of the GNU General Public License as published by +@@ -25,7 +25,7 @@ timestamp='2014-05-01' + # of the GNU General Public License, version 3 ("GPLv3"). + + +-# Please send patches with a ChangeLog entry to config-patches@gnu.org. ++# Please send patches to . + # + # Configuration subroutine to validate and canonicalize a configuration type. + # Supply the specified configuration type as an argument. +@@ -68,7 +68,7 @@ Report bugs and patches to >32)-1; + a&=MASK(32); +- store_val(where,MASK(16),((void *)gote-(void *)got)); + if (s>=ggot && sr_addend=((void *)gote-(void *)got)-s; ++ switch(tp) { ++ case R_MIPS_GOT_HI16: ++ case R_MIPS_CALL_HI16: ++ r->r_info=((ul)R_MIPS_HI16<<56)|(r->r_info&MASK(32)); ++ relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); ++ break; ++ case R_MIPS_GOT_LO16: ++ case R_MIPS_CALL_LO16: ++ r->r_info=((ul)R_MIPS_LO16<<56)|(r->r_info&MASK(32)); ++ relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); ++ break; ++ default: ++ store_val(where,MASK(16),((void *)gote-(void *)got)); ++ break; ++ } + break; + case R_MIPS_GOT_OFST: + recurse(s+a); +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -108,6 +108,10 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| + ELF_R_TYPE(r->r_info)==R_MIPS_GOT_DISP|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_HI16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_LO16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_HI16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_LO16|| + ELF_R_TYPE(r->r_info)==R_MIPS_GOT_PAGE) { + + sym=sym1+ELF_R_SYM(r->r_info); +--- gcl-2.6.12.orig/h/lu.h ++++ gcl-2.6.12/h/lu.h +@@ -143,7 +143,7 @@ struct hashtable { + int ht_size; + short ht_test; + short ht_static; +- SPAD; ++ struct htent *ht_cache; + + }; + +@@ -290,6 +290,8 @@ struct random { + struct readtable { + FIRSTWORD; + struct rtent *rt_self; ++ object rt_case; ++ SPAD; + }; + + struct pathname { +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -373,3 +373,4 @@ typedef struct {void *a,*b,*c,*d;} gmp_r + EXTER gmp_randfnptr_t Mersenne_Twister_Generator_Noseed; + #endif + ++#define collect(p_,f_) (p_)=&(*(p_)=(f_))->c.c_cdr +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -249,6 +249,9 @@ struct freelist { + #define FL_LINK F_LINK + #define SET_LINK(x,val) F_LINK(x) = (address_int) (val) + #define OBJ_LINK(x) ((object) INT_TO_ADDRESS(F_LINK(x))) ++#define PHANTOM_FREELIST(x) ({struct freelist f;(object)((void *)&x+((void *)&f-(void *)&f.f_link));}) ++#define FREELIST_TAIL(tm_) ({struct typemanager *_tm=tm_;\ ++ _tm->tm_free==OBJNULL ? PHANTOM_FREELIST(_tm->tm_free) : _tm->tm_tail;}) + + #define FREE (-1) /* free object */ + +@@ -261,6 +264,8 @@ struct typemanager { + long tm_nppage; /* number per page */ + object tm_free; /* free list */ + /* Note that it is of type object. */ ++ object tm_tail; /* free list tail */ ++ /* Note that it is of type object. */ + long tm_nfree; /* number of free elements */ + long tm_npage; /* number of pages */ + long tm_maxpage; /* maximum number of pages */ +@@ -562,6 +567,9 @@ EXTER unsigned plong signals_allowed, si + /* #define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (!IMMNIL(_a)&&!IMMNIL(_b)&&equal1(_a,_b));}) */ + /* #define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b || (_a!=Cnil&&_b!=Cnil&&equalp1(_a,_b));}) */ + +-#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : eql1(_a,_b));}) ++#define eql_is_eq(a_) (is_imm_fixnum(a_)||valid_cdr(a_)||(a_->d.t>t_complex)) ++ ++#define eql(a_,b_) ({register object _a=(a_);register object _b=(b_);\ ++ _a==_b ? TRUE : (eql_is_eq(_a)||eql_is_eq(_b)||_a->d.t!=_b->d.t ? FALSE : eql1(_a,_b));}) + #define equal(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (IMMNIL(_a)||IMMNIL(_b) ? FALSE : equal1(_a,_b));}) + #define equalp(a_,b_) ({register object _a=(a_);register object _b=(b_);_a==_b ? TRUE : (_a==Cnil||_b==Cnil ? FALSE : equalp1(_a,_b));}) +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1961,3 +1961,6 @@ do_gcl_abort(void); + + int + vsystem(const char *); ++ ++object ++n_cons_from_x(fixnum,object); +--- gcl-2.6.12.orig/h/type.h ++++ gcl-2.6.12/h/type.h +@@ -134,7 +134,7 @@ enum smmode { /* stream mode */ + #define fixnump(a_) SPP(a_,fixnum) + #define readtablep(a_) SPP(a_,readtable) + #define functionp(a_) ({enum type _t=type_of(a_);_t>=t_cfun && _t<=t_closure;}) +-#define compiled_functionp(a_) functionp(a_) ++#define compiled_function_p(a_) functionp(a_) + + #define integerp(a_) ({enum type _tp=type_of(a_); _tp >= t_fixnum && _tp <= t_bignum;}) + #define non_negative_integerp(a_) ({enum type _tp=type_of(a_); (_tp == t_fixnum && fix(a_)>=0) || (_tp==t_bignum && big_sign(a_)>=0);}) +--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp ++++ gcl-2.6.12/lsp/gcl_arraylib.lsp +@@ -27,14 +27,14 @@ + (proclaim '(optimize (safety 2) (space 3))) + + (defvar *baet-hash* (make-hash-table :test 'equal)) +-(defun best-array-element-type (type) +- (or (gethash type *baet-hash*) +- (setf (gethash type *baet-hash*) +- (if type +- (car (member type '(character bit signed-char unsigned-char signed-short unsigned-short +- fixnum short-float long-float t) +- :test 'subtypep)) t))))) +- ++(defun best-array-element-type (type &aux ++ (tps '(character bit signed-char unsigned-char signed-short unsigned-short ++ fixnum short-float long-float t))) ++ (if type ++ (or (car (member type tps)) ++ (gethash type *baet-hash*) ++ (setf (gethash type *baet-hash*) (car (member type tps :test 'subtypep)))) t)) ++ + (defun upgraded-array-element-type (type &optional environment) + (declare (ignore environment)) + (best-array-element-type type)) +--- gcl-2.6.12.orig/lsp/gcl_autoload.lsp ++++ gcl-2.6.12/lsp/gcl_autoload.lsp +@@ -267,7 +267,7 @@ + (push (list (nth nfree *type-list*) typename) + link-alist)))))) + (terpri) +- (dolist (info (reverse info-list)) ++ (dolist (info (nreverse info-list)) + (apply #'format t "~8D/~D~19T~6,1F%~@[~8D~]~35T~{~A~^ ~}" + (append (cdr info) + (if (assoc (car info) link-alist) +--- gcl-2.6.12.orig/lsp/gcl_debug.lsp ++++ gcl-2.6.12/lsp/gcl_debug.lsp +@@ -167,7 +167,7 @@ + ,@ (do ((v (cdr lis) (cdr v)) + (i 0 (1+ i)) + (res)) +- ((null v)(reverse res)) ++ ((null v)(nreverse res)) + (push `(setf ,(car v) (mv-ref ,i)) res)))) + + (defmacro mv-values (&rest lis) +@@ -175,7 +175,7 @@ + ,@ (do ((v (cdr lis) (cdr v)) + (i 0 (1+ i)) + (res)) +- ((null v)(reverse res)) ++ ((null v)(nreverse res)) + (push `(set-mv ,i ,(car v)) res)))) + + ;;start a lisp debugger loop. Exit it by using :step +--- gcl-2.6.12.orig/lsp/gcl_defmacro.lsp ++++ gcl-2.6.12/lsp/gcl_defmacro.lsp +@@ -103,7 +103,7 @@ + (push `(unless (endp ,(dm-nth-cdr (cdr ac) (car ac))) + (dm-too-many-arguments)) body)) + (unless envp (push `(declare (ignore ,env)) body)) +- (list doc ppn `(lambda-block ,name ,(reverse *dl*) ,@(append decls body))) ++ (list doc ppn `(lambda-block ,name ,(nreverse *dl*) ,@(append decls body))) + ) + + (defun dm-vl (vl whole top) +--- gcl-2.6.12.orig/lsp/gcl_directory.lsp ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -41,7 +41,7 @@ + (l (length yy)) + (y (link-expand (vector-push-string yy s) l)) + (y (if (eq y yy) y (make-frame y)))) +- (when (or (eq (stat z) :directory) (zerop (length z))) ++ (when (or (eq (stat1 z) :directory) (zerop (length z))) + (cond ((eq (car x) :wild-inferiors) (recurse-dir z y f)) + (x (walk-dir z y (lambda (q e l) + (declare (ignore l)) +--- gcl-2.6.12.orig/lsp/gcl_evalmacros.lsp ++++ gcl-2.6.12/lsp/gcl_evalmacros.lsp +@@ -23,178 +23,146 @@ + (in-package :si) + + +-(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) ++;(eval-when (compile) (proclaim '(optimize (safety 2) (space 3)))) + ;(eval-when (eval compile) (defun si:clear-compiler-properties (symbol))) +-(eval-when (eval compile) (setq si:*inhibit-macro-special* nil)) +- +-(defmacro sgen (&optional (pref "G")) +- `(load-time-value (gensym ,pref))) ++(eval-when (eval compile) ++ (setq si:*inhibit-macro-special* nil) ++ (defmacro ?cons (f x &aux (s (sgen "?CONS"))) `(let ((,s ,x)) (if (cdr ,s) (cons ,f ,s) (car ,s)))) ++ (defmacro ?list (x &aux (s (sgen "?LIST"))) `(let ((,s ,x)) (when ,s (list ,s)))) ++ (defmacro collect (v r rp np &aux (s (sgen "COLLECT"))) ++ `(let ((,s ,v)) (setf rp (if rp (rplacd rp (list ,s)) (setq r ,s)) rp np))) ++ (defmacro ?let (k kf r) `(let ((r ,r)) (if (eq ,k ,kf) r `(let ((,,k ,,kf)) (declare (ignorable ,,k)) ,r)))) ++ (defmacro ?key (x &aux (s (sgen "?KEY"))) `(if (or (constantp ,x) (symbolp ,x)) ,x ',s))) + ++(defmacro sgen (&optional (pref "G")) `(load-time-value (gensym ,pref))) + + (defmacro defvar (var &optional (form nil form-sp) doc-string) +- `(progn (si:*make-special ',var) +- ,(if doc-string +- `(si:putprop ',var ,doc-string 'variable-documentation)) +- ,(if form-sp +- `(or (boundp ',var) +- (setq ,var ,form))) +- ',var) +- ) ++ (declare (optimize (safety 1))) ++ `(progn (*make-special ',var) ++ ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) ++ ,@(when form-sp `((unless (boundp ',var) (setq ,var ,form)))) ++ ',var)) + + (defmacro defparameter (var form &optional doc-string) +- (if doc-string +- `(progn (si:*make-special ',var) +- (si:putprop ',var ,doc-string 'variable-documentation) +- (setq ,var ,form) +- ',var) +- `(progn (si:*make-special ',var) +- (setq ,var ,form) +- ',var))) ++ (declare (optimize (safety 1))) ++ `(progn (*make-special ',var) ++ ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) ++ (setq ,var ,form) ++ ',var)) + + (defmacro defconstant (var form &optional doc-string) +- (if doc-string +- `(progn (si:*make-constant ',var ,form) +- (si:putprop ',var ,doc-string 'variable-documentation) +- ',var) +- `(progn (si:*make-constant ',var ,form) +- ',var))) ++ (declare (optimize (safety 1))) ++ `(progn (*make-constant ',var ,form) ++ ,@(when doc-string `((putprop ',var ,doc-string 'variable-documentation))) ++ ',var)) + + + ;;; Each of the following macros is also defined as a special form. + ;;; Thus their names need not be exported. + +-(defmacro and (&rest forms) +- (if (endp forms) +- t +- (let ((x (reverse forms))) +- (do ((forms (cdr x) (cdr forms)) +- (form (car x) `(if ,(car forms) ,form))) +- ((endp forms) form)))) +- ) +- +-(defmacro or (&rest forms) +- (if (endp forms) +- nil +- (let ((x (reverse forms))) +- (do ((forms (cdr x) (cdr forms)) +- (form (car x) +- (let ((temp (gensym))) +- `(let ((,temp ,(car forms))) +- (if ,temp ,temp ,form))))) +- ((endp forms) form)))) +- ) +- +-(defun parse-body-header (x &optional doc decl ctps &aux (a (car x))) +- (cond +- ((unless (or doc ctps) (and (stringp a) (cdr x))) (parse-body-header (cdr x) a decl ctps)) +- ((unless ctps (when (consp a) (eq (car a) 'declare))) (parse-body-header (cdr x) doc (cons a decl) ctps)) +- ((when (consp a) (eq (car a) 'check-type)) (parse-body-header (cdr x) doc decl (cons a ctps))) +- (t (values doc (nreverse decl) (nreverse ctps) x)))) ++(defmacro and (&rest forms &aux r rp np) ++ (declare (optimize (safety 1))) ++ (do ((y forms))((endp y) (if forms r t)) ++ (let ((x (pop y))) ++ (if (constantp x) (unless (if (eval x) y) (collect x r rp np) (setq y nil)) ++ (if y (collect `(if ,@(setq np (list x))) r rp np) ++ (collect x r rp np)))))) ++ ++(defmacro or (&rest forms &aux r rp np (s (sgen "OR"))) ++ (declare (optimize (safety 1))) ++ (do ((y forms))((endp y) r) ++ (let ((x (pop y))) ++ (if (constantp x) (when (eval x) (collect x r rp np) (setq y nil)) ++ (if (symbolp x) (collect `(if ,x ,@(setq np (list x))) r rp np) ++ (if y (collect `(let ((,s ,x)) (if ,s ,@(setq np (list s)))) r rp np) ++ (collect x r rp np))))))) ++ ++(defun parse-body-header (x) ++ (let* ((doc x)(x (or (when (stringp (car x)) (cdr x)) x)) ++ (dec x)(x (member-if-not (lambda (x) (when (consp x) (eq (car x) 'declare))) x)) ++ (ctp x)(x (member-if-not (lambda (x) (when (consp x) (eq (car x) 'check-type))) x))) ++ (values (car (ldiff doc dec)) (ldiff dec ctp) (ldiff ctp x) x))) + + (defmacro locally (&rest body) + (multiple-value-bind +- (doc decls ctps body) ++ (doc dec) + (parse-body-header body) ++ (declare (ignore doc)) + `(let (,@(mapcan (lambda (x &aux (z (pop x))(z (if (eq z 'type) (pop x) z))) + (case z + ((ftype inline notinline optimize) nil) + (otherwise (mapcar (lambda (x) (list x x)) x)))) +- (apply 'append (mapcar 'cdr decls)))) +- ,@(when doc (list doc)) +- ,@decls +- ,@ctps ++ (apply 'append (mapcar 'cdr dec)))) + ,@body))) + +-(defmacro loop (&rest body &aux (tag (gensym))) +- `(block nil (tagbody ,tag (progn ,@body) (go ,tag)))) ++(defmacro loop (&rest body &aux (tag (sgen "LOOP"))) ++ `(block nil (tagbody ,tag ,(?cons 'progn body) (go ,tag)))) + +-(import 'while 'user) + (defmacro while (test &rest forms) +- `(loop (unless ,test (return)) ,@forms) ) ++ `(loop (unless ,test (return)) ,@forms)) + + (defmacro defmacro (name vl &rest body) + `(si:define-macro ',name (si:defmacro* ',name ',vl ',body))) + + (defmacro defun (name lambda-list &rest body) +- (multiple-value-bind (doc decl body) +- (find-doc body nil) +- (if doc +- `(progn (setf (get ',name 'si:function-documentation) ,doc) +- (setf (symbol-function ',name) +- #'(lambda ,lambda-list +- ,@decl (block ,name ,@body))) +- ',name) +- `(progn (setf (symbol-function ',name) +- #'(lambda ,lambda-list +- ,@decl (block ,name ,@body))) +- ',name)))) ++ (multiple-value-bind ++ (doc dec ctp body) ++ (parse-body-header body) ++ `(progn ,@(when doc `((setf (get ',name 'function-documentation) ,doc))) ++ (setf (symbol-function ',name) (lambda ,lambda-list ,@dec ,@ctp (block ,name ,@body))) ++ ',name))) + + ; assignment + + (defmacro psetq (&rest args) +- (do ((l args (cddr l)) +- (forms nil) +- (bindings nil)) +- ((endp l) (list* 'let* (nreverse bindings) (nreverse (cons nil forms)))) +- (declare (object l)) +- (let ((sym (gensym))) +- (push (list sym (cadr l)) bindings) +- (push (list 'setq (car l) sym) forms))) +- ) ++ (declare (optimize (safety 1))) ++ (assert (evenp (length args))) ++ (let ((x (let ((i 0)) (mapcon (lambda (x) (when (oddp (incf i)) `((,(cadr x) ,(car x) ,(gensym))))) args)))) ++ (when x ++ `(let* ,(mapcar (lambda (x) `(,(caddr x) ,(car x))) x) ++ (setq ,@(mapcan 'cdr x)) ++ nil)))) + + ; conditionals ++(defmacro cond (&rest clauses &aux r rp np (s (sgen "COND"))) ++ (declare (optimize (safety 1))) ++ (do ((y clauses))((endp y) r) ++ (let* ((x (pop y))(z (pop x))) ++ (if (constantp z) (when (eval z) (collect (if x (?cons 'progn x) z) r rp np) (setq y nil)) ++ (if x (collect `(if ,z ,@(setq np (list (?cons 'progn x)))) r rp np) ++ (if (symbolp z) (collect `(if ,z ,@(setq np (list z))) r rp np) ++ (if y (collect `(let ((,s ,z)) (if ,s ,@(setq np (list s)))) r rp np) ++ (collect `(values ,z) r rp np)))))))) ++ ++(defmacro when (pred &rest body &aux (x (?cons 'progn body))) ++ (declare (optimize (safety 1))) ++ (if (constantp pred) (if (eval pred) x) `(if ,pred ,x))) ++ ++(defmacro unless (pred &rest body &aux (x (?cons 'progn body))) ++ (declare (optimize (safety 1))) ++ (if (constantp pred) (if (not (eval pred)) x) `(if (not ,pred) ,x))) + +-(defmacro cond (&rest clauses &aux (form nil)) +- (let ((x (reverse clauses))) +- (dolist (l x form) +- (cond ((endp (cdr l)) +- (if (or (constantp (car l)) (eq l (car x))) +- (setq form (car l)) +- (let ((sym (gensym))) +- (setq form `(let ((,sym ,(car l))) (if ,sym ,sym ,form)))))) +- ((and (constantp (car l)) (car l)) +- (setq form (if (endp (cddr l)) (cadr l) `(progn ,@(cdr l))))) +- ((setq form (if (endp (cddr l)) +- `(if ,(car l) ,(cadr l) ,form) +- `(if ,(car l) (progn ,@(cdr l)) ,form)))))))) +- +- +-(defmacro when (pred &rest body) +- `(if ,pred (progn ,@body))) ++; program feature + +-(defmacro unless (pred &rest body) +- `(if (not ,pred) (progn ,@body))) ++(defun prog?* (let?* vl body) ++ (multiple-value-bind ++ (doc dec ctp body) ++ (parse-body-header body) ++ (declare (ignore doc)) ++ `(block nil (,let?* ,vl ,@dec (tagbody ,@(append ctp body)))))) + +-; program feature ++(defmacro prog (vl &rest body) ++ (prog?* 'let vl body)) + +-(defmacro prog (vl &rest body &aux (decl nil)) +- (do () +- ((or (endp body) +- (not (consp (car body))) +- (not (eq (caar body) 'declare))) +- `(block nil (let ,vl ,@decl (tagbody ,@body))) +- ) +- (push (car body) decl) +- (pop body)) +- ) +- +-(defmacro prog* (vl &rest body &aux (decl nil)) +- (do () +- ((or (endp body) +- (not (consp (car body))) +- (not (eq (caar body) 'declare))) +- `(block nil (let* ,vl ,@decl (tagbody ,@body))) +- ) +- (push (car body) decl) +- (pop body)) +- ) ++(defmacro prog* (vl &rest body) ++ (prog?* 'let* vl body)) + + ; sequencing + +-(defmacro prog1 (first &rest body &aux (sym (gensym))) ++(defmacro prog1 (first &rest body &aux (sym (sgen "PROG1"))) + `(let ((,sym ,first)) ,@body ,sym)) + +-(defmacro prog2 (first second &rest body &aux (sym (gensym))) ++(defmacro prog2 (first second &rest body &aux (sym (sgen "PROG2"))) + `(progn ,first (let ((,sym ,second)) ,@body ,sym))) + + ; multiple values +@@ -203,115 +171,79 @@ + `(multiple-value-call 'list ,form)) + + (defmacro multiple-value-setq (vars form) +- (do ((vl vars (cdr vl)) +- (sym (gensym)) +- (forms nil) +- (n 0 (1+ n))) +- ((endp vl) `(let ((,sym (multiple-value-list ,form))) ,@forms)) +- (declare (fixnum n) (object vl)) +- (push `(setq ,(car vl) (nth ,n ,sym)) forms)) +- ) +- +-(defmacro multiple-value-bind (vars form &rest body) +- (do ((vl vars (cdr vl)) +- (sym (gensym)) +- (bind nil) +- (n 0 (1+ n))) +- ((endp vl) `(let* ((,sym (multiple-value-list ,form)) ,@(nreverse bind)) +- ,@body)) +- (declare (fixnum n) (object vl)) +- (push `(,(car vl) (nth ,n ,sym)) bind)) +- ) +- +-(defmacro do (control (test . result) &rest body +- &aux (decl nil) (label (gensym)) (vl nil) (step nil)) +- (do () +- ((or (endp body) +- (not (consp (car body))) +- (not (eq (caar body) 'declare)))) +- (push (car body) decl) +- (pop body)) +- (dolist (c control) +- (declare (object c)) +- (if(symbolp c) (setq c (list c))) +- (push (list (car c) (cadr c)) vl) +- (unless (endp (cddr c)) +- (push (car c) step) +- (push (caddr c) step))) +- `(block nil +- (let ,(nreverse vl) +- ,@decl +- (tagbody +- ,label (if ,test (return (progn ,@result))) +- (tagbody ,@body) +- (psetq ,@(nreverse step)) +- (go ,label))))) +- +-(defmacro do* (control (test . result) &rest body +- &aux (decl nil) (label (gensym)) (vl nil) (step nil)) +- (do () +- ((or (endp body) +- (not (consp (car body))) +- (not (eq (caar body) 'declare)))) +- (push (car body) decl) +- (pop body)) +- (dolist (c control) +- (declare (object c)) +- (if(symbolp c) (setq c (list c))) +- (push (list (car c) (cadr c)) vl) +- (unless (endp (cddr c)) +- (push (car c) step) +- (push (caddr c) step))) +- `(block nil +- (let* ,(nreverse vl) +- ,@decl +- (tagbody +- ,label (if ,test (return (progn ,@result))) +- (tagbody ,@body) +- (setq ,@(nreverse step)) +- (go ,label)))) +- ) +- +-(defmacro case (keyform &rest clauses &aux (key (load-time-value (gensym "CASE"))) (c (reverse clauses))) +- (declare (optimize (safety 2))) +- (labels ((sw (x) `(eql ,key ',x))(dfp (x) (or (eq x t) (eq x 'otherwise))) +- (v (x) (if (when (listp x) (not (cdr x))) (car x) x)) +- (m (x c &aux (v (v x))) (if (eq v x) (cons c v) v))) +- `(let ((,key ,keyform)) +- (declare (ignorable ,key)) +- ,(let ((df (when (dfp (caar c)) (m (cdr (pop c)) 'progn)))) +- (reduce (lambda (y c &aux (a (pop c))(v (v a))) +- (when (dfp a) (error "default case must be last")) +- `(if ,(if (when (eq a v) (listp v)) (m (mapcar #'sw v) 'or) (sw v)) ,(m c 'progn) ,y)) +- c :initial-value df))))) +- +-(defmacro ecase (keyform &rest clauses &aux (key (sgen "ECASE"))) +- (declare (optimize (safety 2))) +- `(let ((,key ,keyform)) +- (declare (ignorable ,key)) +- (case ,key ++ (declare (optimize (safety 1))) ++ (let ((syms (mapcar (lambda (x) (declare (ignore x)) (gensym)) (or vars (list nil))))) ++ `(multiple-value-bind ,syms ,form ,@(?list (?cons 'setq (mapcan 'list vars syms))) ,(car syms)))) ++ ++(defmacro multiple-value-bind (vars form &rest body &aux (sym (sgen "MULTIPLE-VALUE-BIND"))) ++ (declare (optimize (safety 1))) ++ `(let* ((,sym (multiple-value-list ,form)) ++ ,@(mapcon (lambda (x) `((,(car x) (car ,sym)) ,@(when (cdr x) `((,sym (cdr ,sym)))))) vars)) ++ (declare (ignorable ,sym)) ++ ,@body)) ++ ++(defun do?* (?* control test result body &aux (label (sgen "DO"))) ++ (multiple-value-bind ++ (doc dec ctp body) ++ (parse-body-header body) ++ (declare (ignore doc)) ++ (labels ((?let (vl dec body) (if (or vl dec) `(,(if ?* 'let* 'let) ,vl ,@dec ,body) body)) ++ (?tagbody (l x y &aux (x (macroexpand x))) (if x `(tagbody ,l ,x ,@(?list (when (eq (car x) 'if) y))) y))) ++ `(block nil ++ ,(?let ++ (mapcar (lambda (x) (if (listp x) (ldiff x (cddr x)) x)) control) ++ dec ++ (?tagbody ++ label ++ `(unless ,test ++ ,@(?list (?cons 'tagbody (append ctp body))) ++ ,@(?list (?cons (if ?* 'setq 'psetq) (mapcan (lambda (x) (when (and (listp x) (cddr x)) (list (car x) (caddr x)))) control))) ++ (go ,label)) ++ `(return ,(?cons 'progn result)))))))) ++ ++(defmacro do (control (test . result) &rest body) ++ (do?* nil control test result body)) ++ ++(defmacro do* (control (test . result) &rest body) ++ (do?* t control test result body)) ++ ++(defmacro case (keyform &rest clauses &aux r rp np (key (?key keyform))) ++ (declare (optimize (safety 1))) ++ (labels ((sw (x) `(eql ,key ,(if (constantp x) x `',x)))) ++ (do ((y clauses))((endp y) (?let key keyform r)) ++ (let* ((x (pop y))(z (pop x))) ++ (if (member z '(t otherwise)) ++ (if y (error "default case must be last") (collect (?cons 'progn x) r rp np)) ++ (when z ++ (if (constantp key) ++ (let ((key (eval key))) (when (if (listp z) (member key z) (eql key z)) (collect (?cons 'progn x) r rp np) (setq y nil))) ++ (collect `(if ,(if (listp z) (?cons 'or (mapcar #'sw z)) (sw z)) ++ ,@(setq np (list (?cons 'progn x)))) r rp np)))))))) ++ ++(defmacro ecase (keyform &rest clauses &aux (key (?key keyform))) ++ (declare (optimize (safety 1))) ++ (?let key keyform ++ `(case ,key + ,@(mapcar (lambda (x) (if (member (car x) '(t otherwise)) (cons (list (car x)) (cdr x)) x)) clauses) + (otherwise + (error 'type-error :datum ,key + :expected-type '(member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses)))))))) + ++(defmacro ccase (keyform &rest clauses &aux (key (?key keyform))) ++ (declare (optimize (safety 1))) ++ (?let key keyform ++ `(do nil (nil) ++ (case ,key ++ ,@(mapcar (lambda (x &aux (k (pop x))) ++ `(,(if (member k '(t otherwise)) (list k) k) (return ,(?cons 'progn x)))) clauses) ++ (otherwise ++ (check-type ,key (member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses))))))))) + +-(defmacro ccase (keyform &rest clauses &aux (key (sgen "CCASE"))) +- (declare (optimize (safety 2))) +- `(let ((,key ,keyform)) +- (declare (ignorable ,key)) +- (do nil (nil) +- (case ,key +- ,@(mapcar (lambda (x &aux (k (pop x))) +- `(,(if (member k '(t otherwise)) (list k) k) (return ,(if (cdr x) (cons 'progn x) (car x))))) clauses) +- (otherwise +- (check-type ,key (member ,@(apply 'append (mapcar (lambda (x &aux (x (car x))) (if (listp x) x (list x))) clauses))))))))) +- +-(defmacro return (&optional (val nil)) `(return-from nil ,val)) +- +-(defmacro dolist ((var form &optional (val nil)) &rest body +- &aux (temp (gensym))) +- `(do* ((,temp ,form (cdr ,temp)) (,var (car ,temp) (car ,temp))) ++ ++(defmacro return (&optional val) `(return-from nil ,val)) ++ ++(defmacro dolist ((var form &optional (val nil)) &rest body &aux (temp (sgen "DOLIST"))) ++ `(do* ((,temp ,form (cdr ,temp))(,var (car ,temp) (car ,temp))) + ((endp ,temp) ,val) + ,@body)) + +@@ -327,59 +259,19 @@ + ;; appears to treat this as positive or negative depending on the sign + ;; of the other argument in the comparison, apparently to symmetrize + ;; the long integer range. 20040403 CM. +-(defmacro dotimes ((var form &optional (val nil)) &rest body) +- (cond +- ((symbolp form) +- (let ((temp (gensym))) +- `(cond ((< ,form 0) +- (let ((,var 0)) +- (declare (fixnum ,var) (ignorable ,var)) +- ,val)) +- ((<= ,form most-positive-fixnum) +- (let ((,temp ,form)) +- (declare (fixnum ,temp)) +- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) +- (declare (fixnum ,var)) +- ,@body))) +- (t +- (let ((,temp ,form)) +- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) +- ,@body)))))) +- ((constantp form) +- (cond ((< form 0) +- `(let ((,var 0)) +- (declare (fixnum ,var) (ignorable ,var)) +- ,val)) +- ((<= form most-positive-fixnum) +- `(do* ((,var 0 (1+ ,var))) ((>= ,var ,form) ,val) +- (declare (fixnum ,var)) +- ,@body)) +- (t +- `(do* ((,var 0 (1+ ,var))) ((>= ,var ,form) ,val) +- ,@body)))) +- (t +- (let ((temp (gensym))) +- `(let ((,temp ,form)) +- (cond ((< ,temp 0) +- (let ((,var 0)) +- (declare (fixnum ,var) (ignorable ,var)) +- ,val)) +- ((<= ,temp most-positive-fixnum) +- (let ((,temp ,temp)) +- (declare (fixnum ,temp)) +- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) +- (declare (fixnum ,var)) +- ,@body))) +- (t +- (do* ((,var 0 (1+ ,var))) ((>= ,var ,temp) ,val) +- ,@body)))))))) +- ++(defmacro dotimes ((var form &optional val) &rest body &aux (s (sgen "DOTIMES"))(m (sgen "DOTIMES"))) ++ `(let* ((,s (block nil ,form))(,m (min ,s most-positive-fixnum))) ++ (declare (fixnum ,m)) ++ (do ((,var 0 (1+ ,var))) ++ ((>= ,var ,m) (if (eql ,s ,m) ,val (do ((,var ,m (1+ ,var)))((>= ,var ,s) ,val) ,@body))) ++ (declare (fixnum ,var)) ++ ,@body))) + + (defmacro declaim (&rest l) +- `(eval-when (compile eval load) +- ,@(mapcar #'(lambda (x) `(proclaim ',x)) l))) ++ `(eval-when (compile eval load) ++ ,@(mapcar (lambda (x) `(proclaim ',x)) l))) + +-(defmacro lambda ( &rest l) `(function (lambda ,@l))) ++(defmacro lambda (&rest l) `(function (lambda ,@l))) + + (defun compiler-macro-function (name) + (get name 'compiler-macro-prop)) +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -380,7 +380,7 @@ + + (defun get-byte-stream-nchars (s) + (let* ((tp (stream-element-type s))) +- (ceiling (if (consp tp) (cadr tp) char-length) char-length))) ++ (values (ceiling (if (consp tp) (cadr tp) char-length) char-length)))) + + ;; (defun parse-integer (s &key start end (radix 10) junk-allowed) + ;; (declare (optimize (safety 1))) +@@ -488,21 +488,19 @@ + (stream (load-stream p print))) + (when verbose (format t ";; Finished loading ~s~%" p)))) + +-(defun ensure-directories-exist (ps &key verbose &aux created) ++(defun ensure-directories-exist (ps &key verbose) + (declare (optimize (safety 1))) + (check-type ps pathname-designator) + (when (wild-pathname-p ps) + (error 'file-error :pathname ps :format-control "Pathname is wild")) +- (labels ((d (x y &aux (z (ldiff x y)) (n (namestring (make-pathname :directory z)))) +- (when (when z (stringp (car (last z)))) +- (unless (eq :directory (stat n)) +- (mkdir n) +- (setq created t) +- (when verbose (format *standard-output* "Creating directory ~s~%" n)))) +- (when y (d x (cdr y))))) +- (let ((pd (pathname-directory ps))) +- (d pd (cdr pd))) +- (values ps created))) ++ (let ((pd (pathname-directory ps)) ls) ++ (dotimes (i (length pd)) ++ (let ((s (namestring (make-pathname :directory (if (zerop i) pd (ldiff pd (last pd i))))))) ++ (if (eq (stat1 s) :directory) (return) (push s ls)))) ++ (dolist (s ls) ++ (mkdir s) ++ (when verbose (format *standard-output* "Creating directory ~s~%" s))) ++ (values ps (if ls t)))) + + (defun file-length (x) + (declare (optimize (safety 1))) +@@ -511,7 +509,7 @@ + (let ((s (broadcast-stream-streams x))) (if s (file-length (car (last s))) 0)) + (multiple-value-bind (tp sz) (stat x) + (declare (ignore tp)) +- (/ sz (get-byte-stream-nchars x))))) ++ (values (truncate sz (get-byte-stream-nchars x)))))) + + (defun file-position (x &optional (pos :start pos-p)) + (declare (optimize (safety 1))) +--- gcl-2.6.12.orig/lsp/gcl_loop.lsp ++++ gcl-2.6.12/lsp/gcl_loop.lsp +@@ -793,6 +793,8 @@ a LET-like macro, and a SETQ-like macro, + (unless (= (length before-loop) (length after-loop)) + (error "LOOP-BODY called with non-synched before- and after-loop lists.")) + ;;All our work is done from these copies, working backwards from the end: ++ (when (equal before-loop after-loop) ++ (setq main-body (append before-loop main-body) before-loop nil after-loop nil));accelerator + (setq rbefore (reverse before-loop) rafter (reverse after-loop)) + (labels ((psimp (l) + (let ((ans nil)) +--- gcl-2.6.12.orig/lsp/gcl_parse_namestring.lsp ++++ gcl-2.6.12/lsp/gcl_parse_namestring.lsp +@@ -2,15 +2,6 @@ + + (deftype seqind nil `fixnum) + +-(defun match-beginning (i &aux (v *match-data*)) +- (declare ((vector fixnum) v)(seqind i)) +- (the (or (integer -1 -1 ) seqind) (aref v i))) +-(defun match-end (i &aux (v *match-data*)) +- (declare ((vector fixnum) v)(seqind i)) +- (the (or (integer -1 -1 ) seqind) (aref v (+ i (ash (length v) -1))))) +- +-(declaim (inline match-beginning match-end)) +- + (defun dir-conj (x) (if (eq x :relative) :absolute :relative)) + + (defvar *up-key* :up) +--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.12/lsp/gcl_predlib.lsp +@@ -348,8 +348,7 @@ + ;; FIXME this needs to be more robust + (defun known-type-p (type) + (when (consp type) (setq type (car type))) +- (if (or (equal (string type) "ERROR") +- (member type ++ (if (or (member type + '(t nil boolean null symbol keyword atom cons list sequence + signed-char unsigned-char signed-short unsigned-short + number integer bignum rational ratio float method-combination +@@ -370,8 +369,9 @@ + storage-condition stream-error string-stream structure-class + style-warning synonym-stream two-way-stream structure-object + type-error unbound-slot unbound-variable undefined-function +- warning )) +- (get type 's-data)) ++ warning) :test 'eq) ++ (get type 's-data) ++ (equal (string type) "ERROR")) + t + nil)) + +--- gcl-2.6.12.orig/lsp/gcl_rename_file.lsp ++++ gcl-2.6.12/lsp/gcl_rename_file.lsp +@@ -26,7 +26,7 @@ + (defun delete-file (f &aux (pf (truename f))(nf (namestring pf))) + (declare (optimize (safety 1))) + (check-type f pathname-designator) +- (unless (if (eq :directory (stat nf)) (rmdir nf) (unlink nf)) ++ (unless (if (eq :directory (stat1 nf)) (rmdir nf) (unlink nf)) + (error 'file-error :pathname (pathname nf) :format-control "Cannot delete pathname.")) + t) + +--- gcl-2.6.12.orig/lsp/gcl_seqlib.lsp ++++ gcl-2.6.12/lsp/gcl_seqlib.lsp +@@ -25,7 +25,7 @@ + (in-package :si) + + +-(proclaim '(optimize (safety 2) (space 3))) ++;(proclaim '(optimize (safety 2) (space 3))) + + + (proclaim '(function seqtype (t) t)) +@@ -274,40 +274,87 @@ + (list 'quote f))) + + (defmacro eval-body () *body*) ++(defmacro mcf (x) `(when ,x (coerce ,x 'function))) ++(deftype function-designator nil `(or (and symbol (not boolean)) function)) ++(defmacro rcollect (r rp form) ++ `(let ((tmp ,form)) ++ (setq ,rp (last (if ,rp (rplacd ,rp tmp) (setq ,r tmp)))))) ++ ++ (defmacro dcollect (r rp form) ++ `(let ((tmp ,form)) ++ (declare (dynamic-extent tmp)) ++ (setq ,rp (cond (,rp (rplacd ,rp tmp) tmp) ((setq ,r tmp)))))) ++ + ) + ++(defun remove (item sequence &key key test test-not from-end count (start 0) end ++ &aux (kf (mcf key))(tf (mcf test))(tnf (mcf test-not)) r rp q qp xz (from-end (when count from-end)) ++ (l (listp sequence))(ln (if l array-dimension-limit (length sequence))) ++ (e (if end (min ln (max 0 end)) ln)) ++ (c (if count (min ln (max 0 count)) ln))) ++ ++ (declare (optimize (safety 1))(dynamic-extent q)(fixnum c e)) ++ ++ (check-type sequence sequence) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ (check-type count (or null integer)) ++ (check-type key (or null function-designator)) ++ (check-type test (or null function-designator)) ++ (check-type test-not (or null function-designator)) ++ ++ (cond ((unless from-end l) ++ (do ((i start (1+ i))(j 0)(s (if (zerop start) sequence (nthcdr start sequence)) (cdr s))) ++ ((or (endp s) (>= i e) (>= j c)) (rcollect r rp sequence) r) ++ (declare (fixnum i j)) ++ (let* ((x (car s))(kx (if kf (funcall kf x) x))) ++ (when (cond (tf (funcall tf item kx))(tnf (not (funcall tnf item kx)))((eql item kx))) ++ (do nil ((eq sequence s) (setq sequence (cdr sequence))) (rcollect r rp (cons (pop sequence) nil))) ++ (incf j))))) ++ (t ++ (do* ((j 0 (1+ j))) ++ ((not (when (< j c) ++ (setq xz (position item sequence ++ :start (if (unless from-end xz) (1+ xz) start) ++ :end (if (when from-end xz) xz end) ++ :key kf :test tf :test-not tnf :from-end from-end))))) ++ (declare (fixnum j)) ++ (if from-end (push xz q) (dcollect q qp (cons xz nil)))) ++; (print q) ++ (cond ((not q) sequence) ++ (l (do* ((lq -1 (car q))(q q (cdr q))(v sequence (cdr v)))((not q) (rcollect r rp v) r) ++ (declare (fixnum lq)) ++ (dotimes (i (the fixnum (- (car q) lq 1))) (declare (fixnum i))(rcollect r rp (cons (pop v) nil))))) ++ ((let ((r (make-array (- (length sequence) (length q)) :element-type (array-element-type sequence)))) ++ (do* ((j 0 (+ j (- (car q) lq 1)))(lq -1 (car q))(q q (cdr q))) ++ ((when (replace r sequence :start1 j :start2 (1+ lq) :end2 (car q)) (not q)) r))))))) ++) + +-(defseq remove () t nil +- (if (not from-end) +- `(if (listp sequence) +- (let ((l sequence) (l1 nil)) +- (do ((i 0 (f+ 1 i))) +- ((>= i start)) +- (declare (fixnum i)) +- (push (car l) l1) +- (pop l)) +- (do ((i start (f+ 1 i)) (j 0)) +- ((or (>= i end) (>= j count) (endp l)) +- (nreconc l1 l)) +- (declare (fixnum i j)) +- (cond ((call-test test test-not item (funcall key (car l))) +- (setf j (f+ 1 j)) +- (pop l)) +- (t +- (push (car l) l1) +- (pop l))))) +- (delete item sequence +- :from-end from-end +- :test test :test-not test-not +- :start start :end end +- :count count +- :key key)) +- `(delete item sequence +- :from-end from-end +- :test test :test-not test-not +- :start start :end end +- :count count +- :key key))) ++(defun remove-if (p s &key key from-end count (start 0) end &aux (kf (mcf key))) ++ ++ (declare (optimize (safety 1))) ++ ++ (check-type p function-designator) ++ (check-type s sequence) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ (check-type count (or null integer)) ++ (check-type key (or null function-designator)) ++ ++ (remove p s :key kf :test #'funcall :start start :end end :count count :from-end from-end)) ++ ++(defun remove-if-not (p s &key key from-end count (start 0) end &aux (kf (mcf key))) ++ ++ (declare (optimize (safety 1))) ++ ++ (check-type p function-designator) ++ (check-type s sequence) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ (check-type count (or null integer)) ++ (check-type key (or null function-designator)) ++ ++ (remove p s :key kf :test-not #'funcall :start start :end end :count count :from-end from-end)) + + + (defseq delete () t t +--- gcl-2.6.12.orig/lsp/gcl_setf.lsp ++++ gcl-2.6.12/lsp/gcl_setf.lsp +@@ -197,6 +197,7 @@ + (defsetf symbol-plist si:set-symbol-plist) + (defsetf gethash (k h &optional d) (v) `(si:hash-set ,k ,h ,v)) + (defsetf row-major-aref si:aset1) ++(defsetf readtable-case si::set-readtable-case) + (defsetf documentation (s d) (v) + `(case ,d + (variable (si:putprop ,s ,v 'variable-documentation)) +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -582,7 +582,7 @@ First directory is checked for first nam + (defvar *tmp-dir*) + + (defun ensure-dir-string (str) +- (if (eq (stat str) :directory) ++ (if (eq (stat1 str) :directory) + (coerce-slash-terminated str) + str)) + +@@ -590,7 +590,7 @@ First directory is checked for first nam + (dolist (x `(,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) + (when x + (let ((x (coerce-slash-terminated x))) +- (when (eq (stat x) :directory) ++ (when (eq (stat1 x) :directory) + (return-from get-temp-dir x)))))) + + +--- gcl-2.6.12.orig/lsp/gcl_translate_pathname.lsp ++++ gcl-2.6.12/lsp/gcl_translate_pathname.lsp +@@ -51,7 +51,7 @@ + + (defun list-toggle-case (x f) + (typecase x +- (string (funcall f x)) ++ (string (values (funcall f x))) + (cons (mapcar (lambda (x) (list-toggle-case x f)) x)) + (otherwise x))) + +--- gcl-2.6.12.orig/lsp/gcl_truename.lsp ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -6,7 +6,7 @@ + (set-fr (fr e &aux (fr (or fr (frame 0 b)))) (setf (fill-pointer fr) e) fr)) + (let* ((i (string-match +dirsep+ str b)) + (fr (set-fr fr (if (eql i -1) n i))) +- (l (when (eq (stat fr) :link) (readlinkat 0 fr)))) ++ (l (when (eq (stat1 fr) :link) (readlinkat 0 fr)))) + (cond (l (let ((b (if (eql #\/ (aref l 0)) 0 b))) + (link-expand (string-concatenate (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) + ((eql i -1) str) +@@ -25,7 +25,7 @@ + (error 'file-error :pathname pd :format-control "Pathname is wild")) + (let* ((ns (ensure-dir-string (link-expand ns))) + (ppd (if (eq (namestring pd) ns) pd (pathname ns)))) +- (unless (or (zerop (length ns)) (stat ns)) ++ (unless (or (zerop (length ns)) (stat1 ns)) + (error 'file-error :pathname ns :format-control "Pathname does not exist")) + (let* ((d (pathname-directory ppd)) + (d1 (subst :back :up d)) +@@ -38,5 +38,5 @@ + (check-type pd pathname-designator) + (when (wild-pathname-p pn) + (error 'file-error :pathname pn :format-control "Pathname is wild")) +- (when (eq (stat (link-expand (namestring pn))) :file) ++ (when (eq (stat1 (link-expand (namestring pn))) :file) + (truename pn))) +--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp ++++ gcl-2.6.12/lsp/sys-proclaim.lisp +@@ -3,239 +3,282 @@ + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*)) +- COMMON-LISP::T) +- SYSTEM::RESET-SYS-PATHS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::VECTOR COMMON-LISP::T)) +- SYSTEM::CONTEXT-VEC)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) ++ 9223372036854775807) ++ COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) ++ SYSTEM::SMALLNTHCDR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- SLOOP::PARSE-LOOP-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE +- SYSTEM::GET-INDEX-NODE SLOOP::LOOP-PEEK +- ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::STEP-READ-LINE +- SYSTEM::SET-UP-TOP-LEVEL SLOOP::LOOP-POP SYSTEM::SET-ENV +- SYSTEM::DBL COMMON-LISP::TYPE-ERROR SYSTEM::INSPECT-INDENT +- SLOOP::PARSE-LOOP-COLLECT SYSTEM::CLEANUP +- SYSTEM::DEFAULT-SYSTEM-BANNER +- SYSTEM::CURRENT-DIRECTORY-PATHNAME ANSI-LOOP::LOOP-DO-WITH +- SYSTEM::INIT-BREAK-POINTS SYSTEM::TEST-ERROR +- SYSTEM::GET-SIG-FN-NAME SLOOP::PARSE-ONE-WHEN-CLAUSE +- ANSI-LOOP::LOOP-DO-DO SYSTEM::READ-EVALUATED-FORM +- SYSTEM::INSPECT-INDENT-1 ANSI-LOOP::LOOP-DO-NAMED +- SLOOP::PARSE-LOOP-FOR SYSTEM::ALL-TRACE-DECLARATIONS +- ANSI-LOOP::LOOP-GET-FORM ANSI-LOOP::LOOP-BIND-BLOCK +- SLOOP::PARSE-LOOP-WHEN SYSTEM::TOP-LEVEL +- SYSTEM::DM-TOO-FEW-ARGUMENTS SYSTEM::KCL-TOP-RESTARTS +- SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::SHOW-RESTARTS +- SYSTEM::DM-TOO-MANY-ARGUMENTS SYSTEM::SETUP-LINEINFO +- SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER +- SLOOP::PARSE-LOOP1 SLOOP::LOOP-UN-POP +- ANSI-LOOP::LOOP-DO-FINALLY SYSTEM::INSPECT-READ-LINE +- ANSI-LOOP::LOOP-CONTEXT SYSTEM::SET-CURRENT +- ANSI-LOOP::LOOP-DO-REPEAT SYSTEM::ILLEGAL-BOA +- COMMON-LISP::LISP-IMPLEMENTATION-VERSION +- ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-DO-INITIALLY +- ANSI-LOOP::LOOP-GET-PROGN)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ SYSTEM::NORMALIZE-TYPE SYSTEM::PNL1 ++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS SYSTEM::DM-BAD-KEY ++ SYSTEM::S-DATA-INCLUDES ++ ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS ++ COMMON-LISP::HOST-NAMESTRING ++ COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM COMMON-LISP::LOGNOT ++ SYSTEM::BREAK-FORWARD-SEARCH-STACK ++ SLOOP::SUBSTITUTE-SLOOP-BODY ++ COMMON-LISP::CONCATENATED-STREAM-STREAMS ++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS SYSTEM::ADD-TO-HOTLIST ++ SYSTEM::RESTART-REPORT-FUNCTION COMMON-LISP::THIRD ++ SYSTEM::DWIM SYSTEM::GET-INSTREAM SYSTEM::TOGGLE-CASE ++ SYSTEM::INSTREAM-P COMMON-LISP::DELETE-FILE ++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE COMMON-LISP::ISQRT ++ SYSTEM::INSERT-BREAK-POINT SYSTEM::WILD-DIR-ELEMENT-P ++ COMMON-LISP::ABS SYSTEM::WHICH COMMON-LISP::ACOS ++ SYSTEM::COERCE-SLASH-TERMINATED ++ COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS ++ ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD ++ COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM SYSTEM::DIR-P ++ SYSTEM::SETUP-INFO SYSTEM::S-DATA-TYPE ++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS ++ SYSTEM::PRINT-SYMBOL-APROPOS SYSTEM::S-DATA-FROZEN ++ SYSTEM::REAL-ASINH ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS ++ SLOOP::PARSE-NO-BODY SYSTEM::INSPECT-STRING SYSTEM::PRINT-FRS ++ SYSTEM::LEAP-YEAR-P SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE ++ SYSTEM::RESTART-INTERACTIVE-FUNCTION ++ SYSTEM::S-DATA-SLOT-DESCRIPTIONS SYSTEM::S-DATA-STATICP ++ SYSTEM::INSPECT-STRUCTURE COMMON-LISP::ASINH ++ ANSI-LOOP::LOOP-PATH-USER-DATA SYSTEM::RE-QUOTE-STRING ++ SYSTEM::MLP SYSTEM::GET-STRING-INPUT-STREAM-INDEX ++ SYSTEM::INFO-GET-FILE COMMON-LISP::EIGHTH ++ SYSTEM::SHOW-BREAK-POINT SYSTEM::SIMPLE-ARRAY-P ++ COMMON-LISP::RESTART-NAME SLOOP::POINTER-FOR-COLLECT ++ COMMON-LISP::PHASE SYSTEM::LNP ++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE ++ SLOOP::LOOP-COLLECT-KEYWORD-P SYSTEM::S-DATA-HAS-HOLES ++ SYSTEM::EVAL-FEATURE ANSI-LOOP::DESTRUCTURING-SIZE ++ COMMON-LISP::BROADCAST-STREAM-STREAMS ++ ANSI-LOOP::LOOP-PATH-FUNCTION COMMON-LISP::BYTE-POSITION ++ ANSI-LOOP::LOOP-MINIMAX-TYPE COMMON-LISP::TANH ++ SYSTEM::BKPT-FILE SYSTEM::FRS-KIND ++ SYSTEM::S-DATA-PRINT-FUNCTION SYSTEM::UNIQUE-ID ++ SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::INSPECT-PACKAGE ++ ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA SYSTEM::BKPT-FILE-LINE ++ ANSI-LOOP::LOOP-EMIT-BODY SYSTEM::PATCH-SHARP ++ ANSI-LOOP::LOOP-COLLECTOR-P SYSTEM::DIR-CONJ ++ SYSTEM::CHECK-TRACE-SPEC ANSI-LOOP::LOOP-COLLECTOR-HISTORY ++ ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS SYSTEM::FIX-LOAD-PATH ++ ANSI-LOOP::LOOP-COLLECTOR-NAME SYSTEM::PATH-STREAM-NAME ++ SLOOP::LOOP-LET-BINDINGS ANSI-LOOP::LOOP-TYPED-INIT ++ FPE::ST-LOOKUP SYSTEM::IHS-VISIBLE SYSTEM::INFO-GET-TAGS ++ SYSTEM::EXPAND-HOME-DIR SYSTEM::DM-KEY-NOT-ALLOWED ++ ANSI-LOOP::LOOP-UNIVERSE-P ++ SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY ++ COMMON-LISP::CONSTANTLY SYSTEM::WILD-NAMESTRING-P ++ SYSTEM::INSPECT-NUMBER SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P ++ COMMON-LISP::FOURTH SYSTEM::NODES-FROM-INDEX ++ SYSTEM::LOGICAL-PATHNAME-HOST-P SYSTEM::S-DATA-NAMED ++ COMMON-LISP::INVOKE-DEBUGGER SYSTEM::INSPECT-VECTOR ++ SYSTEM::VERSION-PARSE SYSTEM::WILD-PATH-ELEMENT-P ++ SLOOP::RETURN-SLOOP-MACRO SYSTEM::REGEXP-CONV ++ SYSTEM::NUMBER-OF-DAYS-FROM-1900 ++ COMMON-LISP::ECHO-STREAM-INPUT-STREAM SYSTEM::CHDIR ++ SYSTEM::DBL-RPL-LOOP COMMON-LISP::ASIN COMMON-LISP::RATIONAL ++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++ COMMON-LISP::NAMESTRING SYSTEM::TRACE-ONE-PREPROCESS ++ SYSTEM::TERMINAL-INTERRUPT SYSTEM::SEQTYPE SYSTEM::S-DATA-RAW ++ SYSTEM::GET-NEXT-VISIBLE-FUN FPE::XMM-LOOKUP ++ SYSTEM::MAKE-KCL-TOP-RESTART ANSI-LOOP::LOOP-MINIMAX-P ++ ANSI-LOOP::LOOP-MAXMIN-COLLECTION ++ COMMON-LISP::COMPILER-MACRO-FUNCTION SYSTEM::BKPT-FUNCTION ++ SYSTEM::DIRECTORY-LIST-CHECK SYSTEM::S-DATA-SLOT-POSITION ++ SYSTEM::SHORT-NAME SYSTEM::DBL-EVAL ++ ANSI-LOOP::LOOP-COLLECTOR-DATA SYSTEM::S-DATA-DOCUMENTATION ++ ANSI-LOOP::LOOP-EMIT-FINAL-VALUE COMMON-LISP::NINTH ++ SYSTEM::CHECK-DECLARATIONS ANSI-LOOP::LOOP-PATH-NAMES ++ COMMON-LISP::LOGICAL-PATHNAME COMMON-LISP::SIGNUM ++ COMMON-LISP::FIND-ALL-SYMBOLS COMMON-LISP::FIFTH ++ SYSTEM::S-DATA-P ANSI-LOOP::LOOP-CONSTANTP SYSTEM::IDESCRIBE ++ SYSTEM::BKPT-FORM ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE ++ SLOOP::SLOOP-SLOOP-MACRO SYSTEM::NEXT-STACK-FRAME ++ SYSTEM::INSPECT-CONS SYSTEM::KNOWN-TYPE-P ++ SYSTEM::RESET-TRACE-DECLARATIONS COMMON-LISP::SINH ++ ANSI-LOOP::LOOP-PATH-P COMMON-LISP::PROVIDE ++ SYSTEM::INSPECT-SYMBOL SYSTEM::FIND-DOCUMENTATION ++ ANSI-LOOP::LOOP-MAKE-DESETQ COMMON-LISP::TENTH ++ SYSTEM::MAKE-DEFPACKAGE-FORM COMMON-LISP::FILE-WRITE-DATE ++ COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM ++ COMMON-LISP::TRUENAME COMMON-LISP::COMPLEMENT ++ COMMON-LISP::FIRST ANSI-LOOP::LOOP-COLLECTOR-CLASS ++ ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS COMMON-LISP::ATANH ++ SYSTEM::LOGICAL-PATHNAMEP COMMON-LISP::DIRECTORY-NAMESTRING ++ SYSTEM::RESTART-P ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE ++ SYSTEM::FIND-KCL-TOP-RESTART COMMON-LISP::FILE-NAMESTRING ++ COMMON-LISP::STREAM-EXTERNAL-FORMAT COMMON-LISP::SECOND ++ COMMON-LISP::FILE-LENGTH SYSTEM::INSTREAM-STREAM ++ ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE COMMON-LISP::PATHNAME ++ SYSTEM::DO-F COMMON-LISP::FILE-AUTHOR ++ SYSTEM::LOAD-PATHNAME-EXISTS SLOOP::AVERAGING-SLOOP-MACRO ++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN ANSI-LOOP::LOOP-UNIVERSE-ANSI ++ ANSI-LOOP::LOOP-PSEUDO-BODY SLOOP::PARSE-LOOP ++ ANSI-LOOP::LOOP-HACK-ITERATION SYSTEM::S-DATA-CONC-NAME ++ SYSTEM::SEARCH-STACK ANSI-LOOP::LOOP-DO-THEREIS ++ COMMON-LISP::BYTE-SIZE ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE ++ COMMON-LISP::ACOSH SYSTEM::GET-PATH ++ COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS ++ SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::ENSURE-DIR-STRING ++ SYSTEM::FREEZE-DEFSTRUCT SYSTEM::PRINT-IHS ++ SYSTEM::INSPECT-CHARACTER COMMON-LISP::ARRAY-DIMENSIONS ++ SLOOP::PARSE-LOOP-INITIALLY SYSTEM::COMPUTING-ARGS-P ++ SYSTEM::INSTREAM-STREAM-NAME SYSTEM::PROCESS-ARGS FPE::GREF ++ SYSTEM::S-DATA-NAME ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS ++ SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::S-DATA-INCLUDED ++ SYSTEM::WALK-THROUGH SYSTEM::RESTART-FUNCTION ++ SLOOP::TRANSLATE-NAME ++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++ COMMON-LISP::SEVENTH COMMON-LISP::CIS FPE::LOOKUP ++ COMMON-LISP::COSH COMMON-LISP::VECTOR-POP SYSTEM::IHS-FNAME ++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK SLOOP::REPEAT-SLOOP-MACRO ++ COMMON-LISP::PROBE-FILE ANSI-LOOP::LOOP-LIST-COLLECTION ++ SYSTEM::CONTEXT-P COMMON-LISP::SIXTH SYSTEM::NC ++ SYSTEM::MAKE-FRAME COMMON-LISP::COMPILE-FILE-PATHNAME ++ SYSTEM::INFO-NODE-FROM-POSITION SYSTEM::NODE-OFFSET ++ SYSTEM::RESTART-TEST-FUNCTION SYSTEM::ALOAD ++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS ++ ANSI-LOOP::LOOP-COLLECTOR-DTYPE SYSTEM::S-DATA-OFFSET ++ SYSTEM::SHOW-ENVIRONMENT COMMON-LISP::SYNONYM-STREAM-SYMBOL ++ SYSTEM::INSPECT-ARRAY ANSI-LOOP::LOOP-MAKE-PSETQ)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- COMMON-LISP::HASH-TABLE) +- SYSTEM::CONTEXT-SPICE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ SYSTEM::BREAK-QUIT SYSTEM::DBL-BACKTRACE ++ SYSTEM::BREAK-PREVIOUS SYSTEM::INFO-ERROR SYSTEM::BREAK-VS ++ SYSTEM::BREAK-LOCAL SYSTEM::IHS-BACKTRACE ++ ANSI-LOOP::LOOP-OPTIONAL-TYPE SYSTEM::BREAK-NEXT ++ COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-BDS ++ COMMON-LISP::CONTINUE SYSTEM::SHOW-BREAK-VARIABLES)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::OR COMMON-LISP::NULL +- COMMON-LISP::HASH-TABLE)) +- SYSTEM::CONTEXT-HASH)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::FIXNUM) +- ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::RELATIVE-LINE +- SYSTEM::LENEL SYSTEM::GET-NODE-INDEX SYSTEM::FASLINK +- SYSTEM::THE-END)) ++ (COMMON-LISP::VECTOR COMMON-LISP::T)) ++ SYSTEM::CONTEXT-VEC)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*)) + COMMON-LISP::T) +- SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::DESETQ1 +- COMMON-LISP::LOGANDC2 ANSI-LOOP::MAKE-LOOP-MINIMAX +- COMMON-LISP::WRITE-BYTE SYSTEM::MATCH-DIMENSIONS +- SLOOP::IN-CAREFULLY-SLOOP-FOR SLOOP::SUM-SLOOP-COLLECT +- SYSTEM::DOT-DIR-P SLOOP::IN-FRINGE-SLOOP-MAP +- SLOOP::COLLATE-SLOOP-COLLECT ANSI-LOOP::LOOP-TMEMBER +- FPE::READ-OPERANDS SYSTEM::IN-INTERVAL-P SYSTEM::SUBSTRINGP +- FPE::PAREN-READER ANSI-LOOP::HIDE-VARIABLE-REFERENCES +- SYSTEM::QUOTATION-READER SYSTEM::ALL-MATCHES SYSTEM::GET-MATCH +- SYSTEM::ADD-FILE ANSI-LOOP::LOOP-DO-ALWAYS SLOOP::THE-TYPE +- SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR +- SYSTEM::CHECK-SEQ-START-END SLOOP::MAKE-VALUE +- SLOOP::THEREIS-SLOOP-COLLECT ANSI-LOOP::LOOP-DO-WHILE +- COMMON-LISP::COERCE ANSI-LOOP::LOOP-TEQUAL +- ANSI-LOOP::LOOP-DECLARE-VARIABLE COMMON-LISP::LOGNAND +- COMMON-LISP::LOGORC1 SYSTEM::BREAK-STEP-NEXT +- SLOOP::LOGXOR-SLOOP-COLLECT COMMON-LISP::LOGNOR +- COMPILER::COMPILER-DEF-HOOK ANSI-LOOP::LOOP-TASSOC +- SYSTEM::GET-LINE-OF-FORM SLOOP::MAXIMIZE-SLOOP-COLLECT +- ANSI-LOOP::LOOP-DO-IF SYSTEM::SETF-EXPAND SYSTEM::DM-V +- SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::NTHCDR +- SYSTEM::CONDITION-PASS SYSTEM::DISPLAY-COMPILED-ENV +- COMMON-LISP::LDB-TEST ANSI-LOOP::LOOP-MAYBE-BIND-FORM +- SYSTEM::SUPER-GO SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS +- FPE::RF SYSTEM::SUB-INTERVAL-P SYSTEM::LEFT-PARENTHESIS-READER +- COMMON-LISP::FILE-STRING-LENGTH SYSTEM::OBJLT SYSTEM::MSUB +- SYSTEM::COERCE-TO-STRING SYSTEM::SAFE-EVAL +- SYSTEM::SET-PATH-STREAM-NAME SYSTEM::SET-BACK +- ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION COMMON-LISP::LOGTEST +- SYSTEM::*BREAK-POINTS* SLOOP::=-SLOOP-FOR +- SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::KEYWORD-SUPPLIED-P +- SLOOP::COUNT-SLOOP-COLLECT FPE::%-READER COMMON-LISP::LOGORC2 +- SYSTEM::SEQUENCE-CURSOR SYSTEM::LOOKUP-KEYWORD +- COMMON-LISP::BYTE SYSTEM::PARSE-SLOT-DESCRIPTION +- COMMON-LISP::LOGANDC1 SYSTEM::DM-NTH-CDR FPE::0-READER +- SLOOP::L-EQUAL SYSTEM::LIST-DELQ SYSTEM::DM-NTH +- COMMON-LISP::LDB SYSTEM::SETF-HELPER +- SLOOP::NEVER-SLOOP-COLLECT SLOOP::PARSE-LOOP-MAP +- COMMON-LISP::NTH SYSTEM::BREAK-STEP-INTO +- SYSTEM::GET-INFO-CHOICES SLOOP::IN-TABLE-SLOOP-MAP +- SYSTEM::GET-NODES COMMON-LISP::VECTOR-PUSH +- COMMON-LISP::PATHNAME-MATCH-P SYSTEM::DBL-UP +- ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::READ-INSTRUCTION +- SLOOP::ALWAYS-SLOOP-COLLECT SYSTEM::SET-DIR SYSTEM::INFO-AUX +- SYSTEM::DISPLAY-ENV COMMON-LISP::DOCUMENTATION +- SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS)) ++ SYSTEM::RESET-SYS-PATHS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMMON-LISP::APROPOS ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE +- COMMON-LISP::FFLOOR SYSTEM::PRINT-DOC SYSTEM::INFO +- SYSTEM::PARSE-BODY-HEADER COMMON-LISP::INVOKE-RESTART +- SYSTEM::BREAK-FUNCTION SYSTEM::SHOW-INFO COMMON-LISP::FROUND +- COMMON-LISP::GET-SETF-EXPANSION COMMON-LISP::PARSE-NAMESTRING +- SYSTEM::APROPOS-DOC COMMON-LISP::ENSURE-DIRECTORIES-EXIST +- COMMON-LISP::USE-VALUE COMMON-LISP::READ-FROM-STRING +- COMMON-LISP::FTRUNCATE COMMON-LISP::STORE-VALUE +- SYSTEM::STEPPER SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE +- COMMON-LISP::APROPOS-LIST COMMON-LISP::FCEILING +- COMMON-LISP::WRITE-TO-STRING +- COMMON-LISP::DECODE-UNIVERSAL-TIME)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::MAYBE-BREAK SYSTEM::MME3 SYSTEM::FIND-LINE-IN-FUN ++ SYSTEM::SETF-STRUCTURE-ACCESS SYSTEM::EXPAND-RANGE ++ SYSTEM::MINMAX SYSTEM::COERCE-TO-CONDITION ++ SLOOP::FIRST-SLOOP-FOR SLOOP::FIRST-USE-SLOOP-FOR ++ SYSTEM::DO-BREAK-LEVEL SYSTEM::ELSUB ++ ANSI-LOOP::LOOP-FOR-ARITHMETIC SYSTEM::CALL-TEST ++ SYSTEM::ELEMENT SYSTEM::LOAD-PATHNAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::SETF-EXPAND-1 SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS +- SYSTEM::WARN-VERSION ANSI-LOOP::LOOP-TRANSLATE +- ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::PRINT-LOOP-UNIVERSE +- ANSI-LOOP::LOOP-STANDARD-EXPANSION +- ANSI-LOOP::LOOP-ANSI-FOR-EQUALS SYSTEM::DM-VL +- SYSTEM::SHARP-A-READER COMMON-LISP::DEPOSIT-FIELD +- SYSTEM::RESTART-CASE-EXPRESSION-CONDITION +- SYSTEM::APPLY-DISPLAY-FUN ANSI-LOOP::HIDE-VARIABLE-REFERENCE +- SYSTEM::FLOATING-POINT-ERROR SYSTEM::GET-SLOT-POS ++ SYSTEM::SHARP-P-READER ANSI-LOOP::HIDE-VARIABLE-REFERENCE ++ SYSTEM::CHECK-TRACE-ARGS SYSTEM::SHARP-U-READER ++ SYSTEM::FLOATING-POINT-ERROR ANSI-LOOP::LOOP-FOR-IN ++ COMMON-LISP::DEPOSIT-FIELD SYSTEM::GET-SLOT-POS ++ SYSTEM::SHARP-A-READER SYSTEM::SHARP-V-READER ++ SYSTEM::PATHNAME-PARSE ++ SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS SYSTEM::SETF-EXPAND-1 ++ COMMON-LISP::DPB SYSTEM::RESTART-CASE-EXPRESSION-CONDITION ++ SYSTEM::CHECK-S-DATA ANSI-LOOP::LOOP-FOR-BEING ++ SYSTEM::TO-REGEXP-OR-NAMESTRING SYSTEM::APPLY-DISPLAY-FUN ++ ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ANSI-LOOP::LOOP-SUM-COLLECTION ++ ANSI-LOOP::LOOP-FOR-ON SYSTEM::MFR ++ ANSI-LOOP::LOOP-STANDARD-EXPANSION SYSTEM::PROG?* + ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE +- SYSTEM::MAKE-BREAK-POINT SYSTEM::SHARP-V-READER +- SYSTEM::TO-REGEXP-OR-NAMESTRING ANSI-LOOP::LOOP-FOR-ON +- SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-SUM-COLLECTION +- SYSTEM::SHARP-P-READER SYSTEM::MAKE-T-TYPE +- ANSI-LOOP::LOOP-FOR-ACROSS SYSTEM::MFR SYSTEM::RECURSE-DIR +- SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-FOR-BEING +- COMMON-LISP::DPB SYSTEM::SHARP-DQ-READER +- SYSTEM::CHECK-TRACE-ARGS SYSTEM::DEFMACRO* +- SYSTEM::CHECK-S-DATA FPE::REF)) ++ SYSTEM::SHARP-DQ-READER SYSTEM::RECURSE-DIR SYSTEM::DM-VL ++ ANSI-LOOP::LOOP-FOR-ACROSS ANSI-LOOP::PRINT-LOOP-UNIVERSE ++ SYSTEM::WARN-VERSION ANSI-LOOP::LOOP-TRANSLATE ++ SYSTEM::DEFMACRO* SYSTEM::MAKE-BREAK-POINT SYSTEM::MAKE-T-TYPE ++ FPE::REF)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ SYSTEM::MME2 COMMON-LISP::SUBSTITUTE-IF-NOT ++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH ++ COMMON-LISP::SUBSTITUTE SYSTEM::WALK-DIR ++ SYSTEM::CHECK-TYPE-SYMBOL COMMON-LISP::TRANSLATE-PATHNAME ++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH ++ COMMON-LISP::MAP ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH ++ ANSI-LOOP::ADD-LOOP-PATH SLOOP::LOOP-DECLARE-BINDING ++ SYSTEM::COMPLETE-PROP SYSTEM::MATCH-COMPONENT ++ COMMON-LISP::NSUBSTITUTE COMMON-LISP::NSUBSTITUTE-IF ++ COMMON-LISP::SUBSTITUTE-IF COMMON-LISP::NSUBSTITUTE-IF-NOT ++ SYSTEM::PUSH-LET-BINDING ANSI-LOOP::LOOP-MAKE-VARIABLE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- SYSTEM::FIND-IHS COMMON-LISP::NSET-DIFFERENCE +- COMMON-LISP::BIT-NAND SYSTEM::BREAK-CALL +- COMMON-LISP::COUNT-IF-NOT COMMON-LISP::DELETE +- SYSTEM::INTERNAL-COUNT COMMON-LISP::BIT-ORC1 +- COMMON-LISP::DELETE-IF COMMON-LISP::BIT-ANDC1 +- SYSTEM::VECTOR-PUSH-STRING COMMON-LISP::MISMATCH +- COMMON-LISP::NOTEVERY SYSTEM::PROCESS-ERROR COMMON-LISP::TYPEP +- COMMON-LISP::BIT-IOR COMMON-LISP::BIT-EQV +- COMMON-LISP::COUNT-IF COMMON-LISP::REMOVE-IF +- COMMON-LISP::EVERY COMMON-LISP::POSITION-IF-NOT +- COMMON-LISP::ADJUST-ARRAY COMMON-LISP::VECTOR-PUSH-EXTEND +- SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::COUNT +- COMMON-LISP::DELETE-IF-NOT COMMON-LISP::NINTERSECTION +- COMMON-LISP::FIND-IF-NOT COMMON-LISP::BIT-ORC2 +- COMMON-LISP::SUBSETP COMMON-LISP::SOME SYSTEM::WREADDIR +- COMMON-LISP::SET-DIFFERENCE COMMON-LISP::UNION +- COMMON-LISP::BIT-XOR SLOOP::PARSE-LOOP-MACRO +- COMMON-LISP::REPLACE COMMON-LISP::REMOVE +- SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ANDC2 +- COMMON-LISP::READ-SEQUENCE COMMON-LISP::CERROR +- COMMON-LISP::INTERSECTION COMMON-LISP::POSITION-IF +- ANSI-LOOP::LOOP-CHECK-DATA-TYPE SYSTEM::INTERNAL-COUNT-IF +- COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE +- COMMON-LISP::MAP-INTO COMMON-LISP::MAKE-SEQUENCE +- COMMON-LISP::SET-EXCLUSIVE-OR SLOOP::IN-ARRAY-SLOOP-FOR +- COMMON-LISP::FIND-IF COMMON-LISP::SEARCH COMMON-LISP::FILL +- COMMON-LISP::FIND COMMON-LISP::NOTANY +- COMMON-LISP::NSET-EXCLUSIVE-OR COMMON-LISP::BIT-NOR +- COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::POSITION +- COMMON-LISP::BIT-AND)) ++ COMMON-LISP::DELETE-IF-NOT COMMON-LISP::FILL ++ COMMON-LISP::SET-EXCLUSIVE-OR ANSI-LOOP::LOOP-CHECK-DATA-TYPE ++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::SOME ++ COMMON-LISP::COUNT COMMON-LISP::NOTANY SYSTEM::INTERNAL-COUNT ++ COMMON-LISP::POSITION-IF-NOT COMMON-LISP::SET-DIFFERENCE ++ SLOOP::IN-ARRAY-SLOOP-FOR COMMON-LISP::NUNION ++ COMMON-LISP::BIT-NAND SYSTEM::PROCESS-ERROR ++ COMMON-LISP::BIT-ANDC2 COMMON-LISP::POSITION-IF ++ COMMON-LISP::NSET-DIFFERENCE COMMON-LISP::WRITE-SEQUENCE ++ COMMON-LISP::BIT-XOR COMMON-LISP::READ-SEQUENCE ++ COMMON-LISP::DELETE-IF COMMON-LISP::MAP-INTO ++ COMMON-LISP::SUBSETP COMMON-LISP::REMOVE-IF-NOT ++ COMMON-LISP::FIND-IF COMMON-LISP::INTERSECTION ++ COMMON-LISP::REPLACE COMMON-LISP::VECTOR-PUSH-EXTEND ++ COMMON-LISP::BIT-ORC2 COMMON-LISP::POSITION ++ COMMON-LISP::CERROR COMMON-LISP::FIND COMMON-LISP::BIT-ORC1 ++ SYSTEM::BREAK-CALL SLOOP::PARSE-LOOP-MACRO COMMON-LISP::EVERY ++ COMMON-LISP::COUNT-IF-NOT COMMON-LISP::ADJUST-ARRAY ++ COMMON-LISP::SEARCH COMMON-LISP::REMOVE-IF ++ COMMON-LISP::NOTEVERY COMMON-LISP::TYPEP COMMON-LISP::COUNT-IF ++ SYSTEM::WREADDIR SYSTEM::INTERNAL-COUNT-IF COMMON-LISP::DELETE ++ COMMON-LISP::NSET-EXCLUSIVE-OR COMMON-LISP::UNION ++ COMMON-LISP::BIT-EQV COMMON-LISP::NINTERSECTION ++ COMMON-LISP::MISMATCH SYSTEM::FIND-IHS COMMON-LISP::REMOVE ++ SYSTEM::VECTOR-PUSH-STRING COMMON-LISP::BIT-IOR ++ COMMON-LISP::FIND-IF-NOT COMMON-LISP::MAKE-SEQUENCE ++ COMMON-LISP::BIT-ANDC1 SLOOP::LOOP-ADD-BINDING ++ COMMON-LISP::BIT-NOR COMMON-LISP::BIT-AND)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::FIND-LINE-IN-FUN ANSI-LOOP::LOOP-FOR-ARITHMETIC +- SYSTEM::EXPAND-RANGE SYSTEM::MAYBE-BREAK SYSTEM::MINMAX +- SLOOP::FIRST-USE-SLOOP-FOR SLOOP::FIRST-SLOOP-FOR +- SYSTEM::SETF-STRUCTURE-ACCESS SYSTEM::DO-BREAK-LEVEL +- SYSTEM::CALL-TEST SYSTEM::ELEMENT SYSTEM::LOAD-PATHNAME +- SYSTEM::COERCE-TO-CONDITION SYSTEM::ELSUB)) ++ SYSTEM::DO-ARG-COUNT-ERROR SYSTEM::PUSH-SUB-LIST-BINDING)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE +- SYSTEM::PRINT-STACK-FRAME)) ++ SYSTEM::MAKE-PREDICATE SYSTEM::DO?* SYSTEM::MAKE-CONSTRUCTOR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::T) +- COMMON-LISP::ENCODE-UNIVERSAL-TIME)) ++ ANSI-LOOP::LOOP-SEQUENCER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH +- SYSTEM::COMPLETE-PROP SYSTEM::CHECK-TYPE-SYMBOL +- COMMON-LISP::NSUBSTITUTE +- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH COMMON-LISP::SUBSTITUTE +- COMMON-LISP::TRANSLATE-PATHNAME COMMON-LISP::NSUBSTITUTE-IF +- COMMON-LISP::MAP SLOOP::LOOP-DECLARE-BINDING SYSTEM::WALK-DIR +- SYSTEM::MATCH-COMPONENT ANSI-LOOP::LOOP-MAKE-VARIABLE +- ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::SUBSTITUTE-IF +- COMMON-LISP::NSUBSTITUTE-IF-NOT SYSTEM::MME2 +- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH +- COMMON-LISP::SUBSTITUTE-IF-NOT SYSTEM::PUSH-LET-BINDING)) ++ SYSTEM::EXPAND-WILD-DIRECTORY SLOOP::DEF-LOOP-INTERNAL ++ COMMON-LISP::MERGE SYSTEM::PRINT-STACK-FRAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -243,88 +286,120 @@ + (COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807)) + COMMON-LISP::T) +- SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) ++ SYSTEM::SHARP-EQ-READER SYSTEM::SHARP-SHARP-READER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) + COMMON-LISP::T) +- SYSTEM::DO-ARG-COUNT-ERROR SYSTEM::PUSH-SUB-LIST-BINDING)) ++ COMMON-LISP::ENCODE-UNIVERSAL-TIME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) ++ SYSTEM::UNIVERSAL-ERROR-HANDLER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::PARSE-DEFMACRO SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMMON-LISP::SUBST COMMON-LISP::SUBST-IF-NOT ++ COMMON-LISP::SUBST-IF SYSTEM::MASET)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::READ-INSPECT-COMMAND SYSTEM::RESTART-PRINT ++ ANSI-LOOP::LOOP-GET-COLLECTION-INFO SYSTEM::SHARP-+-READER ++ SYSTEM::VERIFY-KEYWORDS SYSTEM::SHARP-S-READER ++ SYSTEM::LIST-MERGE-SORT SYSTEM::SHARP---READER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::PARSE-BODY COMMON-LISP::SORT ++ SLOOP::FIND-IN-ORDERED-LIST COMMON-LISP::REDUCE ++ COMMON-LISP::STABLE-SORT COMMON-LISP::SUBTYPEP)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) +- COMMON-LISP::T) +- ANSI-LOOP::LOOP-SEQUENCER)) ++ COMMON-LISP::*) ++ SYSTEM::TRACE-CALL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- SYSTEM::UNIVERSAL-ERROR-HANDLER)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(SYSTEM::SI-FIND-CLASS SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF +- SYSTEM::CONDITION-CLASS-P SYSTEM::UNTRACE-ONE +- SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SIMPLE-CONDITION-CLASS-P +- SYSTEM::CONDITIONP SYSTEM::AUTOLOAD +- SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP +- FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::TRACE-ONE +- SYSTEM::AUTOLOAD-MACRO SYSTEM::DEFINE-STRUCTURE +- SYSTEM::SI-CLASS-NAME)) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::PUSH-OPTIONAL-BINDING)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- SYSTEM::INSTREAM-NAME ANSI-LOOP::LOOP-LIST-STEP +- COMMON-LISP::PRIN1-TO-STRING ANSI-LOOP::NAMED-VARIABLE +- SYSTEM::WAITING SYSTEM::FIND-DECLARATIONS COMMON-LISP::INSPECT +- SYSTEM::END-WAITING SYSTEM::BREAK-GO SYSTEM::INFO-SUBFILE +- COMMON-LISP::INVOKE-RESTART-INTERACTIVELY +- ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::INSPECT-OBJECT +- SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::EXPAND-RANGES +- SYSTEM::GET-&ENVIRONMENT COMMON-LISP::DESCRIBE +- COMMON-LISP::PRINC-TO-STRING)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ SYSTEM::MAKE-CONTEXT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++ ANSI-LOOP::MAKE-LOOP-UNIVERSE SYSTEM::MAKE-S-DATA ++ SYSTEM::NEXT-MATCH COMMON-LISP::USER-HOMEDIR-PATHNAME ++ SYSTEM::STEP-NEXT ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL ++ COMMON-LISP::VECTOR SLOOP::PARSE-LOOP-WITH ++ COMMON-LISP::COMPUTE-RESTARTS COMMON-LISP::BREAK ++ ANSI-LOOP::MAKE-LOOP-PATH ANSI-LOOP::LOOP-GENTEMP ++ COMMON-LISP::ABORT COMMON-LISP::YES-OR-NO-P ++ SYSTEM::MAKE-INSTREAM SYSTEM::DBL-READ ++ SYSTEM::MAYBE-CLEAR-INPUT SYSTEM::MAKE-RESTART ++ ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL COMMON-LISP::Y-OR-N-P ++ SLOOP::PARSE-LOOP-DECLARE ANSI-LOOP::MAKE-LOOP-COLLECTOR ++ SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::STEP-INTO ++ SYSTEM::CURRENT-STEP-FUN COMMON-LISP::DRIBBLE ++ COMMON-LISP::MAKE-PATHNAME SYSTEM::BREAK-LOCALS SYSTEM::LOC ++ SYSTEM::TRANSFORM-KEYWORDS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE +- SYSTEM::MAKE-S-DATA ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL +- ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::CURRENT-STEP-FUN SYSTEM::LOC +- SYSTEM::DBL-READ SYSTEM::MAKE-RESTART +- SYSTEM::TRANSFORM-KEYWORDS COMMON-LISP::Y-OR-N-P +- SYSTEM::NEXT-MATCH COMMON-LISP::COMPUTE-RESTARTS +- SLOOP::PARSE-LOOP-WITH COMMON-LISP::VECTOR SYSTEM::STEP-NEXT +- ANSI-LOOP::MAKE-LOOP-COLLECTOR +- COMMON-LISP::USER-HOMEDIR-PATHNAME SLOOP::PARSE-LOOP-DECLARE +- COMMON-LISP::YES-OR-NO-P SYSTEM::STEP-INTO +- SYSTEM::MAKE-CONTEXT SYSTEM::BREAK-LOCALS +- SYSTEM::DESCRIBE-ENVIRONMENT COMMON-LISP::DRIBBLE +- ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL SYSTEM::MAYBE-CLEAR-INPUT +- COMMON-LISP::BREAK ANSI-LOOP::LOOP-GENTEMP +- ANSI-LOOP::MAKE-LOOP-UNIVERSE SYSTEM::MAKE-INSTREAM +- COMMON-LISP::MAKE-PATHNAME)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES ++ COMMON-LISP::PRIN1-TO-STRING SYSTEM::GET-&ENVIRONMENT ++ COMMON-LISP::INSPECT SYSTEM::BREAK-GO ++ SYSTEM::PARSE-BODY-HEADER COMMON-LISP::PRINC-TO-STRING ++ SYSTEM::EXPAND-RANGES ANSI-LOOP::NAMED-VARIABLE ++ ANSI-LOOP::LOOP-LIST-STEP SYSTEM::INSTREAM-NAME ++ SYSTEM::WAITING SYSTEM::END-WAITING COMMON-LISP::DESCRIBE ++ SYSTEM::INFO-SUBFILE SYSTEM::FIND-DECLARATIONS ++ SYSTEM::INSPECT-OBJECT SYSTEM::BREAK-LEVEL-INVOKE-RESTART ++ COMMON-LISP::INVOKE-RESTART-INTERACTIVELY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::FIXNUM) +- FPE::FE-ENABLE SYSTEM::DBL-WHAT-FRAME)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE ++ SYSTEM::S-DATA-LENGTH SYSTEM::THE-START)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::AUTOLOAD ++ SYSTEM::UNTRACE-ONE SYSTEM::TRACE-ONE SYSTEM::CONDITIONP ++ SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SI-CLASS-NAME ++ SYSTEM::SI-CLASSP SYSTEM::SI-CLASS-OF SYSTEM::SI-FIND-CLASS ++ SYSTEM::CONDITION-CLASS-P SYSTEM::AUTOLOAD-MACRO ++ SYSTEM::WARNINGP SYSTEM::DEFINE-STRUCTURE ++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS ++ SYSTEM::SIMPLE-CONDITION-CLASS-P)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -336,155 +411,9 @@ + SYSTEM::ROUND-UP)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::FIXNUM) +- SYSTEM::ATOI)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- SYSTEM::REGEXP-CONV SYSTEM::DIR-CONJ SYSTEM::DIR-P +- ANSI-LOOP::LOOP-LIST-COLLECTION COMMON-LISP::COSH +- SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::INSPECT-CONS +- SYSTEM::KNOWN-TYPE-P SYSTEM::LNP COMMON-LISP::SEVENTH +- SYSTEM::BKPT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P +- COMMON-LISP::COMPILER-MACRO-FUNCTION +- ANSI-LOOP::LOOP-HACK-ITERATION +- COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM +- SYSTEM::DIRECTORY-LIST-CHECK COMMON-LISP::FILE-WRITE-DATE +- SYSTEM::NORMALIZE-TYPE COMMON-LISP::EIGHTH SYSTEM::TOGGLE-CASE +- SYSTEM::SHOW-ENVIRONMENT +- COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM SYSTEM::GET-PATH +- COMMON-LISP::ASINH SYSTEM::FIND-KCL-TOP-RESTART +- SYSTEM::RESTART-P SYSTEM::EVAL-FEATURE SYSTEM::ALOAD +- COMMON-LISP::PHASE SLOOP::SUBSTITUTE-SLOOP-BODY +- COMMON-LISP::ASIN SYSTEM::NODES-FROM-INDEX +- SYSTEM::MAKE-DEFPACKAGE-FORM ANSI-LOOP::LOOP-COLLECTOR-DTYPE +- SYSTEM::LOGICAL-PATHNAMEP SYSTEM::INSPECT-VECTOR +- ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS +- SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::IHS-VISIBLE +- SLOOP::LOOP-COLLECT-KEYWORD-P ANSI-LOOP::LOOP-TYPED-INIT +- COMMON-LISP::VECTOR-POP SYSTEM::UNIQUE-ID +- ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS +- SYSTEM::SIMPLE-ARRAY-P COMMON-LISP::ACOS SYSTEM::DBL-EVAL +- SYSTEM::INSPECT-STRING SYSTEM::MLP +- SYSTEM::INSTREAM-STREAM-NAME SYSTEM::WILD-NAMESTRING-P +- ANSI-LOOP::LOOP-PATH-FUNCTION +- SYSTEM::GET-STRING-INPUT-STREAM-INDEX +- ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SEQTYPE +- ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS +- SYSTEM::BEST-ARRAY-ELEMENT-TYPE +- ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA SYSTEM::S-DATA-FROZEN +- SYSTEM::S-DATA-DOCUMENTATION SYSTEM::DWIM COMMON-LISP::SIGNUM +- SYSTEM::FIND-DOCUMENTATION ANSI-LOOP::LOOP-COLLECTOR-HISTORY +- ANSI-LOOP::LOOP-MAKE-PSETQ FPE::GREF SYSTEM::S-DATA-OFFSET +- SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::INSTREAM-P +- COMMON-LISP::DIRECTORY-NAMESTRING SYSTEM::INSPECT-ARRAY +- COMMON-LISP::ARRAY-DIMENSIONS +- ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS ANSI-LOOP::LOOP-MINIMAX-P +- SLOOP::RETURN-SLOOP-MACRO SYSTEM::WALK-THROUGH +- SYSTEM::NEXT-STACK-FRAME SYSTEM::S-DATA-NAME COMMON-LISP::TANH +- SYSTEM::BREAK-BACKWARD-SEARCH-STACK COMMON-LISP::TENTH +- SYSTEM::INFO-NODE-FROM-POSITION FPE::ST-LOOKUP +- COMMON-LISP::RESTART-NAME SYSTEM::S-DATA-TYPE +- SYSTEM::BKPT-FILE-LINE COMMON-LISP::FIND-ALL-SYMBOLS +- COMMON-LISP::FIFTH SLOOP::LOOP-LET-BINDINGS +- COMMON-LISP::ECHO-STREAM-INPUT-STREAM +- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED +- COMMON-LISP::PROBE-FILE SYSTEM::MAKE-FRAME +- SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK +- COMMON-LISP::COMPILE-FILE-PATHNAME +- SYSTEM::PRINT-SYMBOL-APROPOS COMMON-LISP::LOGNOT +- SYSTEM::INFO-GET-TAGS SYSTEM::SHORT-NAME +- ANSI-LOOP::LOOP-MINIMAX-TYPE COMMON-LISP::SIXTH +- COMMON-LISP::SECOND ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS +- COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM +- SYSTEM::S-DATA-INCLUDES SYSTEM::RESTART-INTERACTIVE-FUNCTION +- SLOOP::TRANSLATE-NAME SYSTEM::PATCH-SHARP COMMON-LISP::ABS +- ANSI-LOOP::LOOP-CONSTANTP SYSTEM::LEAP-YEAR-P +- ANSI-LOOP::LOOP-UNIVERSE-ANSI ANSI-LOOP::LOOP-EMIT-BODY +- COMMON-LISP::HOST-NAMESTRING COMMON-LISP::FIRST +- SYSTEM::INSERT-BREAK-POINT +- COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS +- COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-PSEUDO-BODY +- SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::S-DATA-HAS-HOLES +- ANSI-LOOP::LOOP-COLLECTOR-NAME COMMON-LISP::FOURTH +- SYSTEM::BKPT-FILE SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY +- SYSTEM::INSTREAM-STREAM SYSTEM::PNL1 SYSTEM::IHS-FNAME +- SYSTEM::S-DATA-SLOT-POSITION SLOOP::PARSE-LOOP +- SYSTEM::CHECK-TRACE-SPEC SYSTEM::S-DATA-CONSTRUCTORS +- SYSTEM::S-DATA-STATICP SYSTEM::CONTEXT-P +- COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS +- SYSTEM::INFO-GET-FILE COMMON-LISP::COMPLEMENT +- SYSTEM::INSPECT-NUMBER SYSTEM::RESET-TRACE-DECLARATIONS +- ANSI-LOOP::LOOP-PATH-P SLOOP::REPEAT-SLOOP-MACRO SYSTEM::DO-F +- SYSTEM::INSPECT-PACKAGE SYSTEM::PATH-STREAM-NAME +- SYSTEM::GET-INSTREAM COMMON-LISP::BYTE-SIZE +- SYSTEM::RESTART-FUNCTION FPE::LOOKUP SYSTEM::S-DATA-CONC-NAME +- COMMON-LISP::PROVIDE SYSTEM::S-DATA-NAMED SYSTEM::PRINT-FRS +- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE SYSTEM::NODE-OFFSET +- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::PRINT-IHS +- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS COMMON-LISP::TRUENAME +- SYSTEM::BREAK-FORWARD-SEARCH-STACK +- COMMON-LISP::CONCATENATED-STREAM-STREAMS SYSTEM::VERSION-PARSE +- SYSTEM::INSPECT-CHARACTER SYSTEM::LOGICAL-PATHNAME-HOST-P +- SYSTEM::DM-BAD-KEY SYSTEM::EXPAND-HOME-DIR +- ANSI-LOOP::LOOP-PATH-USER-DATA +- ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-SYMBOL +- COMMON-LISP::INVOKE-DEBUGGER +- SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P +- COMMON-LISP::BYTE-POSITION COMMON-LISP::ISQRT COMMON-LISP::CIS +- ANSI-LOOP::LOOP-COLLECTOR-CLASS +- COMMON-LISP::SYNONYM-STREAM-SYMBOL ANSI-LOOP::LOOP-PATH-NAMES +- SYSTEM::RE-QUOTE-STRING SYSTEM::INSPECT-STRUCTURE +- COMMON-LISP::RATIONAL FPE::XMM-LOOKUP +- SYSTEM::REWRITE-RESTART-CASE-CLAUSE +- SYSTEM::S-DATA-PRINT-FUNCTION +- SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::SLOOP-SLOOP-MACRO +- COMMON-LISP::NAMESTRING SYSTEM::ENSURE-DIR-STRING +- COMMON-LISP::CONSTANTLY SLOOP::PARSE-LOOP-INITIALLY +- SYSTEM::S-DATA-RAW SYSTEM::ADD-TO-HOTLIST SYSTEM::FRS-KIND +- ANSI-LOOP::LOOP-MAXMIN-COLLECTION +- ANSI-LOOP::LOOP-COLLECTOR-DATA SYSTEM::PROCESS-ARGS +- SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::MAKE-KCL-TOP-RESTART +- COMMON-LISP::ATANH ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD +- COMMON-LISP::SINH ANSI-LOOP::LOOP-UNIVERSE-P +- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED +- SYSTEM::S-DATA-INCLUDED COMMON-LISP::STREAM-EXTERNAL-FORMAT +- SYSTEM::COMPUTING-ARGS-P SYSTEM::REAL-ASINH +- ANSI-LOOP::LOOP-CONSTRUCT-RETURN +- SYSTEM::S-DATA-SLOT-DESCRIPTIONS SYSTEM::FIX-LOAD-PATH +- SYSTEM::CHECK-DECLARATIONS +- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS +- SLOOP::POINTER-FOR-COLLECT COMMON-LISP::LOGICAL-PATHNAME +- SYSTEM::CHDIR SYSTEM::IDESCRIBE +- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS COMMON-LISP::ACOSH +- COMMON-LISP::NINTH ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE +- ANSI-LOOP::LOOP-COLLECTOR-P SYSTEM::S-DATA-P SYSTEM::BKPT-FORM +- COMMON-LISP::FILE-NAMESTRING SYSTEM::TERMINAL-INTERRUPT +- SYSTEM::SETUP-INFO SLOOP::PARSE-NO-BODY +- SYSTEM::DM-KEY-NOT-ALLOWED ANSI-LOOP::LOOP-EMIT-FINAL-VALUE +- SYSTEM::FREEZE-DEFSTRUCT SYSTEM::DBL-RPL-LOOP +- SYSTEM::TRACE-ONE-PREPROCESS +- COMMON-LISP::BROADCAST-STREAM-STREAMS COMMON-LISP::THIRD +- SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::SHOW-BREAK-POINT +- COMMON-LISP::PATHNAME ANSI-LOOP::LOOP-DO-THEREIS +- COMMON-LISP::FILE-AUTHOR ANSI-LOOP::LOOP-MAKE-DESETQ +- SYSTEM::NC SYSTEM::NUMBER-OF-DAYS-FROM-1900 +- SYSTEM::RESTART-TEST-FUNCTION SYSTEM::WHICH +- ANSI-LOOP::DESTRUCTURING-SIZE COMMON-LISP::FILE-LENGTH)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- SYSTEM::BREAK-VS ANSI-LOOP::LOOP-OPTIONAL-TYPE +- SYSTEM::BREAK-BDS SYSTEM::IHS-BACKTRACE SYSTEM::INFO-ERROR +- SYSTEM::BREAK-LOCAL SYSTEM::SHOW-BREAK-VARIABLES +- COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS +- SYSTEM::BREAK-QUIT SYSTEM::DBL-BACKTRACE COMMON-LISP::CONTINUE +- SYSTEM::BREAK-NEXT)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ COMMON-LISP::HASH-TABLE) ++ SYSTEM::CONTEXT-SPICE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +@@ -512,124 +441,227 @@ + SYSTEM::BIGNTHCDR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- COMMON-LISP::FIND-RESTART COMMON-LISP::PATHNAME-HOST +- SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE COMMON-LISP::WARN +- COMMON-LISP::FILE-POSITION ANSI-LOOP::LOOP-WARN +- COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::SBIT +- COMMON-LISP::BIT ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES +- COMMON-LISP::PATHNAME-TYPE COMMON-LISP::MAKE-ARRAY +- ANSI-LOOP::LOOP-ERROR COMMON-LISP::DIRECTORY SYSTEM::DIR-PARSE +- COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME +- SYSTEM::NTH-STACK-FRAME COMMON-LISP::REQUIRE COMMON-LISP::LOAD +- SYSTEM::MGLIST COMMON-LISP::DELETE-DUPLICATES +- COMMON-LISP::PATHNAME-VERSION COMMON-LISP::ENOUGH-NAMESTRING +- SYSTEM::BAD-SEQ-LIMIT COMMON-LISP::REMOVE-DUPLICATES +- COMMON-LISP::PATHNAME-NAME +- COMMON-LISP::MAKE-STRING-INPUT-STREAM SLOOP::LOOP-ADD-TEMPS +- SYSTEM::NLOAD SYSTEM::LIST-MATCHES +- COMMON-LISP::ARRAY-ROW-MAJOR-INDEX +- COMMON-LISP::ARRAY-IN-BOUNDS-P SYSTEM::BREAK-LEVEL +- SYSTEM::PROCESS-SOME-ARGS SYSTEM::TO-REGEXP +- COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::OPEN +- SYSTEM::FILE-SEARCH COMMON-LISP::READ-BYTE +- SYSTEM::FILE-TO-STRING SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR +- COMMON-LISP::SIGNAL SYSTEM::MGSUB COMMON-LISP::WILD-PATHNAME-P +- COMMON-LISP::PATHNAME-DEVICE SYSTEM::LOGICAL-PATHNAME-PARSE +- COMMON-LISP::MERGE-PATHNAMES SYSTEM::INFO-SEARCH +- COMMON-LISP::BIT-NOT)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::DO-REPL +- SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT +- SYSTEM::NEW-SEMI-COLON-READER SYSTEM::FIND-DOC +- ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEWLINE +- COMMON-LISP::RENAME-FILE SYSTEM::LIST-TOGGLE-CASE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMMON-LISP::REDUCE COMMON-LISP::STABLE-SORT +- SYSTEM::PARSE-BODY SLOOP::FIND-IN-ORDERED-LIST +- COMMON-LISP::SUBTYPEP COMMON-LISP::SORT)) ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::ATOI)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::LIST-MERGE-SORT ANSI-LOOP::LOOP-GET-COLLECTION-INFO +- SYSTEM::SHARP---READER SYSTEM::SHARP-S-READER +- SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT +- SYSTEM::SHARP-+-READER SYSTEM::READ-INSPECT-COMMAND)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ ANSI-LOOP::LOOP-DO-INITIALLY SYSTEM::GET-INDEX-NODE ++ SLOOP::PARSE-ONE-WHEN-CLAUSE SYSTEM::STEP-READ-LINE ++ SYSTEM::DM-TOO-MANY-ARGUMENTS SYSTEM::READ-EVALUATED-FORM ++ SYSTEM::DM-TOO-FEW-ARGUMENTS SYSTEM::KCL-TOP-RESTARTS ++ ANSI-LOOP::LOOP-ITERATION-DRIVER ++ SYSTEM::CURRENT-DIRECTORY-PATHNAME SYSTEM::INSPECT-INDENT ++ SYSTEM::CLEANUP ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ++ SLOOP::PARSE-LOOP-WHEN ANSI-LOOP::LOOP-DO-NAMED ++ ANSI-LOOP::LOOP-GET-FORM SYSTEM::GET-TEMP-DIR ++ SYSTEM::ILLEGAL-BOA SYSTEM::SET-UP-TOP-LEVEL ++ SYSTEM::SETUP-LINEINFO ANSI-LOOP::LOOP-CONTEXT ++ SYSTEM::TOP-LEVEL SYSTEM::DBL SLOOP::LOOP-UN-POP ++ SYSTEM::SET-CURRENT ANSI-LOOP::LOOP-GET-PROGN ++ ANSI-LOOP::LOOP-DO-REPEAT SYSTEM::INIT-BREAK-POINTS ++ SLOOP::PARSE-LOOP-FOR SLOOP::LOOP-POP ++ ANSI-LOOP::LOOP-POP-SOURCE ANSI-LOOP::LOOP-DO-WITH ++ ANSI-LOOP::LOOP-DO-DO COMMON-LISP::LISP-IMPLEMENTATION-VERSION ++ ANSI-LOOP::LOOP-DO-RETURN SLOOP::PARSE-LOOP-DO ++ SLOOP::LOOP-PEEK ANSI-LOOP::LOOP-BIND-BLOCK ++ SYSTEM::DEFAULT-SYSTEM-BANNER SLOOP::PARSE-LOOP1 ++ SYSTEM::INSPECT-READ-LINE ANSI-LOOP::LOOP-DO-FINALLY ++ SYSTEM::TEST-ERROR COMMON-LISP::TYPE-ERROR ++ SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::SHOW-RESTARTS ++ SYSTEM::SET-ENV SLOOP::PARSE-LOOP-COLLECT ++ SYSTEM::ALL-TRACE-DECLARATIONS SYSTEM::GET-SIG-FN-NAME ++ SYSTEM::INSPECT-INDENT-1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::PUSH-OPTIONAL-BINDING)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::OR COMMON-LISP::NULL ++ COMMON-LISP::HASH-TABLE)) ++ SYSTEM::CONTEXT-HASH)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::TRACE-CALL)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::LENEL SYSTEM::GET-NODE-INDEX SYSTEM::FASLINK ++ SYSTEM::THE-END ANSI-LOOP::DUPLICATABLE-CODE-P ++ SYSTEM::RELATIVE-LINE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::*) +- SYSTEM::MASET)) ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::DBL-WHAT-FRAME FPE::FE-ENABLE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- SYSTEM::EXPAND-WILD-DIRECTORY)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ SYSTEM::GCL-TOP-LEVEL SYSTEM::BREAK-CURRENT ++ SYSTEM::BREAK-RESUME SYSTEM::BREAK-HELP SYSTEM::BREAK-MESSAGE ++ ANSI-LOOP::LOOP-DO-FOR SYSTEM::SIMPLE-BACKTRACE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- SYSTEM::PARSE-DEFMACRO SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ SYSTEM::PROCESS-SOME-ARGS COMMON-LISP::CONCATENATE ++ SYSTEM::TO-REGEXP COMMON-LISP::PATHNAME-DEVICE ++ SYSTEM::LIST-MATCHES ANSI-LOOP::LOOP-WARN ++ COMMON-LISP::REMOVE-DUPLICATES COMMON-LISP::PATHNAME-HOST ++ COMMON-LISP::BIT COMMON-LISP::SBIT ++ COMMON-LISP::ENOUGH-NAMESTRING SYSTEM::DIR-PARSE ++ SYSTEM::FILE-SEARCH SYSTEM::BREAK-LEVEL ANSI-LOOP::LOOP-ERROR ++ SYSTEM::MGLIST COMMON-LISP::PATHNAME-NAME ++ COMMON-LISP::MAKE-STRING-INPUT-STREAM SLOOP::ADD-FROM-DATA ++ COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME COMMON-LISP::DIRECTORY ++ SYSTEM::FILE-TO-STRING COMMON-LISP::ARRAY-ROW-MAJOR-INDEX ++ SYSTEM::NTH-STACK-FRAME SLOOP::LOOP-ADD-TEMPS ++ COMMON-LISP::WARN ++ ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES ++ SYSTEM::LINK-EXPAND COMMON-LISP::PATHNAME-TYPE ++ COMMON-LISP::OPEN COMMON-LISP::BIT-NOT ++ COMMON-LISP::DELETE-DUPLICATES COMMON-LISP::ERROR ++ COMMON-LISP::FILE-POSITION COMMON-LISP::PATHNAME-VERSION ++ COMMON-LISP::ARRAY-IN-BOUNDS-P COMMON-LISP::REQUIRE ++ SYSTEM::MGSUB COMMON-LISP::MERGE-PATHNAMES COMMON-LISP::LOAD ++ COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::SIGNAL ++ COMMON-LISP::WILD-PATHNAME-P COMMON-LISP::FIND-RESTART ++ SYSTEM::INFO-SEARCH SYSTEM::LOGICAL-PATHNAME-PARSE ++ SYSTEM::BAD-SEQ-LIMIT COMMON-LISP::READ-BYTE ++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE SYSTEM::NLOAD ++ COMMON-LISP::MAKE-ARRAY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) +- SYSTEM::MME3)) ++ COMMON-LISP::RENAME-FILE ANSI-LOOP::ESTIMATE-CODE-SIZE-1 ++ SYSTEM::FIND-DOC SYSTEM::SOURCE-PORTION SYSTEM::NEWLINE ++ SYSTEM::DO-REPL SYSTEM::RESTART-REPORT ++ ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEW-SEMI-COLON-READER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- COMMON-LISP::T) ++ 9223372036854775807)) + COMMON-LISP::T) +- SYSTEM::SMALLNTHCDR)) ++ SYSTEM::GET-CONTEXT SYSTEM::PUSH-CONTEXT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +- SYSTEM::GCL-TOP-LEVEL SYSTEM::BREAK-MESSAGE +- SYSTEM::BREAK-RESUME SYSTEM::SIMPLE-BACKTRACE +- SYSTEM::BREAK-HELP ANSI-LOOP::LOOP-DO-FOR +- SYSTEM::BREAK-CURRENT)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- SYSTEM::S-DATA-LENGTH SYSTEM::THE-START SYSTEM::INSTREAM-LINE +- SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMMON-LISP::PSETF COMMON-LISP::PROG* SYSTEM::BREAK-STEP-INTO ++ SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::SLOOP-FINISH ++ SYSTEM::CHECK-SEQ-START-END SLOOP::SLOOP ++ COMMON-LISP::MULTIPLE-VALUE-SETQ COMMON-LISP::ASSERT ++ SLOOP::MINIMIZE-SLOOP-COLLECT COMMON-LISP::ROTATEF ++ SYSTEM::LIST-TOGGLE-CASE SYSTEM::INCREMENT-CURSOR ++ ANSI-LOOP::LOOP-COLLECT-ANSWER COMMON-LISP::PROG2 ++ SLOOP::SLOOP-SWAP COMMON-LISP::DEFTYPE ++ SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS SYSTEM::?PUSH ++ COMMON-LISP::DO-EXTERNAL-SYMBOLS ++ ANSI-LOOP::LOOP-COLLECT-RPLACD COMMON-LISP::TRACE ++ ANSI-LOOP::LOOP-DO-IF ANSI-LOOP::MAKE-LOOP-MINIMAX ++ SYSTEM::SUBSTRINGP COMMON-LISP::LOGORC2 ++ ANSI-LOOP::LOOP-DO-WHILE ANSI-LOOP::LOOP-LOOKUP-KEYWORD ++ SLOOP::DEF-LOOP-COLLECT SYSTEM::SETF-HELPER ++ COMMON-LISP::WITH-CONDITION-RESTARTS SYSTEM::INSPECT-PRINT ++ SLOOP::PARSE-LOOP-MAP SYSTEM::KEYWORD-SUPPLIED-P ++ COMMON-LISP::LOOP-FINISH ANSI-LOOP::LOOP-TASSOC ++ SYSTEM::GET-LINE-OF-FORM ANSI-LOOP::LOOP-STORE-TABLE-DATA ++ SLOOP::L-EQUAL COMMON-LISP::ETYPECASE ++ SLOOP::THEREIS-SLOOP-COLLECT COMMON-LISP::RETURN ++ SYSTEM::SUB-INTERVAL-P COMMON-LISP::ECASE ++ COMMON-LISP::WRITE-BYTE SYSTEM::LOOKUP-KEYWORD ++ COMMON-LISP::DEFSETF ANSI-LOOP::LOOP-DO-ALWAYS ++ SYSTEM::PARSE-SLOT-DESCRIPTION COMMON-LISP::VECTOR-PUSH ++ SYSTEM::GET-INFO-CHOICES SYSTEM::SETF-EXPAND ++ SYSTEM::LEFT-PARENTHESIS-READER SLOOP::DEF-LOOP-FOR ++ COMMON-LISP::PROG SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS ++ SYSTEM::SUPER-GO COMMON-LISP::LDB SYSTEM::NODE ++ SYSTEM::COERCE-TO-PACKAGE COMMON-LISP::DO SYSTEM::TP-ERROR ++ SYSTEM::GET-NODES SLOOP::THE-TYPE ANSI-LOOP::LOOP-TMEMBER ++ ANSI-LOOP::LOOP-TEQUAL COMMON-LISP::DEFPARAMETER ++ COMMON-LISP::WITH-OPEN-STREAM SYSTEM::DEFINE-SETF-METHOD ++ SYSTEM::IF-ERROR ANSI-LOOP::HIDE-VARIABLE-REFERENCES ++ SLOOP::DESETQ1 COMMON-LISP::LOOP COMMON-LISP::CTYPECASE ++ COMMON-LISP::DEFSTRUCT COMMON-LISP::CASE SYSTEM::DOT-DIR-P ++ SYSTEM::INSPECT-RECURSIVELY COMMON-LISP::DOTIMES ++ SYSTEM::BREAK-STEP-NEXT SYSTEM::ALL-MATCHES ++ COMMON-LISP::LOCALLY SLOOP::IN-TABLE-SLOOP-MAP ++ SYSTEM::DISPLAY-ENV COMMON-LISP::MULTIPLE-VALUE-LIST ++ COMMON-LISP::LDB-TEST COMMON-LISP::DECLAIM ++ COMMON-LISP::WITH-STANDARD-IO-SYNTAX SYSTEM::SGEN ++ SLOOP::ALWAYS-SLOOP-COLLECT COMMON-LISP::PUSHNEW ++ COMMON-LISP::MULTIPLE-VALUE-BIND FPE::%-READER ++ COMMON-LISP::CCASE SLOOP::DEF-LOOP-MACRO ++ ANSI-LOOP::LOOP-REALLY-DESETQ SYSTEM::IN-INTERVAL-P ++ SYSTEM::DBL-UP SLOOP::DEF-LOOP-MAP ANSI-LOOP::LOOP-BODY ++ SYSTEM::SEQUENCE-CURSOR COMMON-LISP::COERCE ++ COMMON-LISP::PATHNAME-MATCH-P SYSTEM::OBJLT ++ COMMON-LISP::RESTART-CASE ++ COMMON-LISP::WITH-HASH-TABLE-ITERATOR COMMON-LISP::STEP ++ SYSTEM::QUOTATION-READER SYSTEM::PUT-AUX COMMON-LISP::TYPECASE ++ SYSTEM::*BREAK-POINTS* COMMON-LISP::LOGTEST ++ SYSTEM::CONDITION-PASS COMMON-LISP::DEFVAR ++ COMMON-LISP::WITH-OUTPUT-TO-STRING SYSTEM::SET-BACK ++ COMMON-LISP::NTHCDR COMMON-LISP::DO-ALL-SYMBOLS ++ SYSTEM::INFO-AUX COMMON-LISP::LOGANDC1 COMMON-LISP::PROG1 ++ FPE::READ-OPERANDS SYSTEM::DISPLAY-COMPILED-ENV ++ COMMON-LISP::DEFCONSTANT SYSTEM::DM-V SLOOP::LOOP-RETURN ++ SYSTEM::ADD-FILE SYSTEM::WHILE SYSTEM::WITHOUT-INTERRUPTS ++ COMMON-LISP::NTH-VALUE COMMON-LISP::OR ++ ANSI-LOOP::LOOP-COPYLIST* SLOOP::IN-CAREFULLY-SLOOP-FOR ++ ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::GET-MATCH ++ ANSI-LOOP::WITH-LOOP-LIST-COLLECTION-HEAD ++ ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION SYSTEM::MV-SETQ ++ SLOOP::COLLATE-SLOOP-COLLECT COMMON-LISP::LOGORC1 ++ SYSTEM::DM-NTH-CDR COMPILER::COMPILER-DEF-HOOK ++ SYSTEM::CHECK-TYPE-EVAL COMMON-LISP::DECF ++ COMMON-LISP::WITH-PACKAGE-ITERATOR SYSTEM::COERCE-TO-STRING ++ COMMON-LISP::DEFINE-MODIFY-MACRO FPE::0-READER ++ COMMON-LISP::WITH-COMPILATION-UNIT COMMON-LISP::LOGNAND ++ COMMON-LISP::CHECK-TYPE COMMON-LISP::INCF ++ SLOOP::MAXIMIZE-SLOOP-COLLECT SYSTEM::ITERATE-OVER-BKPTS ++ SLOOP::LOGXOR-SLOOP-COLLECT SLOOP::NEVER-SLOOP-COLLECT ++ SYSTEM::MV-VALUES SYSTEM::MSUB COMMON-LISP::DO* ++ SLOOP::=-SLOOP-FOR COMMON-LISP::UNLESS ++ SYSTEM::MATCH-DIMENSIONS COMMON-LISP::DOLIST ++ ANSI-LOOP::LOOP-MAYBE-BIND-FORM SLOOP::LOCAL-FINISH ++ COMMON-LISP::PSETQ COMMON-LISP::COND ++ COMMON-LISP::WITH-SIMPLE-RESTART COMMON-LISP::DO-SYMBOLS ++ COMMON-LISP::FILE-STRING-LENGTH COMMON-LISP::LAMBDA ++ ANSI-LOOP::LOOP-ACCUMULATE-MINIMAX-VALUE ++ SLOOP::IN-FRINGE-SLOOP-MAP SYSTEM::SET-DIR ++ COMMON-LISP::WITH-INPUT-FROM-STRING SYSTEM::LIST-DELQ ++ COMMON-LISP::BYTE COMMON-LISP::DOCUMENTATION SYSTEM::SAFE-EVAL ++ COMMON-LISP::DEFMACRO SLOOP::DESETQ COMMON-LISP::POP ++ SLOOP::COUNT-SLOOP-COLLECT SLOOP::LCASE ++ COMMON-LISP::DEFPACKAGE COMMON-LISP::DEFUN COMMON-LISP::TIME ++ COMMON-LISP::LOGNOR COMMON-LISP::RESTART-BIND ++ COMMON-LISP::PUSH COMMON-LISP::SHIFTF COMMON-LISP::AND ++ COMMON-LISP::WHEN SYSTEM::DM-NTH COMMON-LISP::WITH-OPEN-FILE ++ SLOOP::MAKE-VALUE COMMON-LISP::UNTRACE FPE::PAREN-READER ++ ANSI-LOOP::WITH-MINIMAX-VALUE COMMON-LISP::NTH ++ FPE::READ-INSTRUCTION SLOOP::SUM-SLOOP-COLLECT ++ COMMON-LISP::REMF COMMON-LISP::DESTRUCTURING-BIND ++ SYSTEM::SET-PATH-STREAM-NAME FPE::RF COMMON-LISP::LOGANDC2)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +- SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) +\ No newline at end of file ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMMON-LISP::FCEILING COMMON-LISP::APROPOS-LIST ++ COMMON-LISP::READ-FROM-STRING ++ COMMON-LISP::ENSURE-DIRECTORIES-EXIST SYSTEM::APROPOS-DOC ++ COMMON-LISP::FTRUNCATE SYSTEM::BREAK-FUNCTION ++ SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE SYSTEM::STEPPER ++ COMMON-LISP::DECODE-UNIVERSAL-TIME ++ ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE ++ COMMON-LISP::STORE-VALUE COMMON-LISP::GET-SETF-EXPANSION ++ SYSTEM::PRINT-DOC SYSTEM::INFO COMMON-LISP::APROPOS ++ COMMON-LISP::WRITE-TO-STRING COMMON-LISP::USE-VALUE ++ COMMON-LISP::FROUND COMMON-LISP::PARSE-NAMESTRING ++ COMMON-LISP::INVOKE-RESTART COMMON-LISP::FFLOOR ++ SYSTEM::SHOW-INFO)) +\ No newline at end of file +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -182,61 +182,61 @@ void + add_page_to_freelist(char *p, struct typemanager *tm) { + + short t,size; +- long i=tm->tm_nppage,fw; +- object x,f; ++ long fw; ++ object x,xe,f; + struct pageinfo *pp; + +- t=tm->tm_type; ++ t=tm->tm_type; + +- size=tm->tm_size; +- f=tm->tm_free; +- pp=pageinfo(p); +- bzero(pp,sizeof(*pp)); +- pp->type=t; +- pp->magic=PAGE_MAGIC; +- +- if (cell_list_head==NULL) +- cell_list_tail=cell_list_head=pp; +- else if (pp > cell_list_tail) { +- cell_list_tail->next=pp; +- cell_list_tail=pp; +- } +- +- x= (object)pagetochar(page(p)); +- /* set_type_of(x,t); */ +- make_free(x); ++ size=tm->tm_size; ++ pp=pageinfo(p); ++ bzero(pp,sizeof(*pp)); ++ pp->type=t; ++ pp->magic=PAGE_MAGIC; ++ ++ if (cell_list_head==NULL) ++ cell_list_tail=cell_list_head=pp; ++ else if (pp > cell_list_tail) { ++ cell_list_tail->next=pp; ++ cell_list_tail=pp; ++ } ++ ++ x= (object)pagetochar(page(p)); ++ /* set_type_of(x,t); */ ++ make_free(x); + + #ifdef SGC + +- if (sgc_enabled && tm->tm_sgc) +- pp->sgc_flags=SGC_PAGE_FLAG; ++ if (sgc_enabled && tm->tm_sgc) ++ pp->sgc_flags=SGC_PAGE_FLAG; + + #ifndef SGC_WHOLE_PAGE +- if (TYPEWORD_TYPE_P(pp->type)) +- x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; ++ if (TYPEWORD_TYPE_P(pp->type)) ++ x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL; + #endif + +- /* array headers must be always writable, since a write to the +- body does not touch the header. It may be desirable if there +- are many arrays in a system to make the headers not writable, +- but just SGC_TOUCH the header each time you write to it. this +- is what is done with t_structure */ ++ /* array headers must be always writable, since a write to the ++ body does not touch the header. It may be desirable if there ++ are many arrays in a system to make the headers not writable, ++ but just SGC_TOUCH the header each time you write to it. this ++ is what is done with t_structure */ + if (t==(tm_of(t_array)->tm_type)) + pp->sgc_flags|=SGC_PERM_WRITABLE; +- ++ + #endif + +- fw= *(fixnum *)x; +- while (--i >= 0) { +- *(fixnum *)x=fw; +- SET_LINK(x,f); +- f=x; +- x= (object) ((char *)x + size); +- } +- +- tm->tm_free=f; +- tm->tm_nfree += tm->tm_nppage; +- tm->tm_npage++; ++ f=FREELIST_TAIL(tm); ++ fw=x->fw; ++ xe=(object)((void *)x+tm->tm_nppage*size); ++ for (;xfw=fw; ++ SET_LINK(f,x); ++ } ++ ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail=f; ++ tm->tm_nfree+=tm->tm_nppage; ++ tm->tm_npage++; + + } + +@@ -1065,15 +1065,13 @@ make_cons(object a,object d) { + + } + +- +- +-object on_stack_cons(object x, object y) { ++object ++on_stack_cons(object x, object y) { + object p = (object) alloca_val; + load_cons(p,x,y); + return p; + } + +- + DEFUNM_NEW("ALLOCATED",object,fSallocated,SI,1,1,NONE,OO,OO,OO,OO,(object typ),"") + { struct typemanager *tm=(&tm_table[t_from_type(typ)]); + tm = & tm_table[tm->tm_type]; +--- gcl-2.6.12.orig/o/assignment.c ++++ gcl-2.6.12/o/assignment.c +@@ -388,14 +388,7 @@ EVAL: + + OTHERWISE: + vs_base = vs_top; +- vs_push(sLsetf); +- vs_push(place); +- vs_push(form); +- result=vs_top[-1]; +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- stack_cons(); ++ vs_push(list(3,sLsetf,place,result=form)); + /***/ + #define VS_PUSH_ENV \ + if(lex_env[1]){ \ +@@ -428,9 +421,7 @@ FFN(Fpush)(object form) + return; + } + vs_base = vs_top; +- vs_push(sLpush); +- vs_push(form); +- stack_cons(); ++ vs_push(make_cons(sLpush,form)); + /***/ + VS_PUSH_ENV ; + /***/ +@@ -457,9 +448,7 @@ FFN(Fpop)(object form) + return; + } + vs_base = vs_top; +- vs_push(sLpop); +- vs_push(form); +- stack_cons(); ++ vs_push(make_cons(sLpop,form)); + /***/ + VS_PUSH_ENV ; + /***/ +@@ -495,9 +484,7 @@ FFN(Fincf)(object form) + return; + } + vs_base = vs_top; +- vs_push(sLincf); +- vs_push(form); +- stack_cons(); ++ vs_push(make_cons(sLincf,form)); + /***/ + VS_PUSH_ENV ; + /***/ +@@ -533,9 +520,7 @@ FFN(Fdecf)(object form) + return; + } + vs_base = vs_top; +- vs_push(sLdecf); +- vs_push(form); +- stack_cons(); ++ vs_push(make_cons(sLdecf,form)); + /***/ + VS_PUSH_ENV ; + /***/ +--- gcl-2.6.12.orig/o/backq.c ++++ gcl-2.6.12/o/backq.c +@@ -22,7 +22,7 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include "include.h" + + #define attach(x) (vs_head = make_cons(x, vs_head)) +-#define make_list (vs_push(Cnil), stack_cons(), stack_cons()) ++#define make_list (vs_popp,vs_head=list(2,vs_head,*vs_top)) + + + #define QUOTE 1 +--- gcl-2.6.12.orig/o/bind.c ++++ gcl-2.6.12/o/bind.c +@@ -433,10 +433,11 @@ SEARCH_DECLARE: + optional[i].opt_svar_spp); + } + if (rest_flag) { +- vs_push(Cnil); +- for (i = narg, j = nreq+nopt; --i >= j; ) +- vs_head = make_cons(base[i], vs_head); +- bind_var(rest->rest_var, vs_head, rest->rest_spp); ++ object *l=vs_top++; ++ for (i=nreq+nopt;irest_var, vs_head, rest->rest_spp); + } + if (key_flag) { + int allow_other_keys_found=0; +@@ -824,12 +825,11 @@ parse_key(object *base, bool rest, bool + } + } + if (rest) { +- top = vs_top; +- vs_push(Cnil); +- base++; +- while (base < vs_top) +- stack_cons(); +- vs_top = top; ++ object *a,*l; ++ for (l=a=base;as.s_sfdef != NOT_SPECIAL && sym->s.s_mflag) + sym->s.s_sfdef = NOT_SPECIAL; +- cf = alloc_object(t_cfun); +- cf->cf.cf_self = self; +- cf->cf.cf_name = sym; +- cf->cf.cf_data = data; ++ sfn = alloc_object(t_sfun); ++ sfn->sfn.sfn_self = (void *)self;/*FIXME*/ ++ sfn->sfn.sfn_name = sym; ++ sfn->sfn.sfn_data = data; ++ sfn->sfn.sfn_argd=2; + data->cfd.cfd_start=start; + data->cfd.cfd_size=size; +- sym = clear_compiler_properties(sym,cf); +- sym->s.s_gfdef = cf; ++ sym = clear_compiler_properties(sym,sfn); ++ sym->s.s_gfdef = sfn; + sym->s.s_mflag = TRUE; + return sym; + } +--- gcl-2.6.12.orig/o/eval.c ++++ gcl-2.6.12/o/eval.c +@@ -60,38 +60,41 @@ object sSAbreak_stepA; + /* for t_sfun,t_gfun with args on vs stack */ + + static void +-quick_call_sfun(object fun) +-{ DEBUG_AVMA ++quick_call_sfun(object fun) { ++ ++ DEBUG_AVMA + int i=fun->sfn.sfn_argd,n=SFUN_NARGS(i); + enum ftype restype; +- object *x,res,*base; +- object *temp_ar=alloca(n*sizeof(object)); +-/* i=fun->sfn.sfn_argd; */ +-/* n=SFUN_NARGS(i); */ +- base = vs_base; +- if (n != vs_top - base) +- {check_arg_failed(n);} ++ object *x,*base; ++ ++ if (n!=vs_top-vs_base) ++ check_arg_failed(n); ++ + restype = SFUN_RETURN_TYPE(i); + SFUN_START_ARG_TYPES(i); +- /* for moment just support object and int */ + #define COERCE_ARG(a,type) (type==f_object ? a : (object)(fix(a))) +- if (i==0) +- x=vs_base; +- else +- {int j; +- x=temp_ar; +- for (j=0; jcf.cf_self)();return;} +- if (type_of(fun)==t_sfun){call_sfun_no_check(fun); return;} +- if (type_of(fun)==t_gfun) +- {quick_call_sfun(fun); return;} +- if (type_of(fun)==t_vfun) +- {call_vfun(fun); return;} +- if (type_of(fun) == t_symbol) { +- if (fun->s.s_sfdef != NOT_SPECIAL || fun->s.s_mflag) +- FEinvalid_function(fun); +- if (fun->s.s_gfdef == OBJNULL) +- FEundefined_function(fun); +- fun = fun->s.s_gfdef; +- if (type_of(fun)==t_cfun){(*fun->cf.cf_self)(); +- return;} +- } +- funcall_no_event(fun); ++ ++ switch(type_of(fun)) { ++ case t_cfun: ++ (*fun->cf.cf_self)(); ++ return; ++ case t_sfun: ++ call_sfun_no_check(fun); return; ++ case t_gfun: ++ quick_call_sfun(fun); return; ++ case t_vfun: ++ call_vfun(fun); return; ++ case t_symbol: ++ if (fun->s.s_sfdef != NOT_SPECIAL || fun->s.s_mflag) ++ FEinvalid_function(fun); ++ if (fun->s.s_gfdef == OBJNULL) ++ FEundefined_function(fun); ++ super_funcall_no_event(fun->s.s_gfdef); ++ return; ++ default: ++ funcall_no_event(fun); ++ } ++ + } + + #ifdef USE_BROKEN_IEVAL +@@ -814,13 +823,7 @@ EVAL: + bds_bind(siVevalhook, Cnil); + vs_base = vs_top; + vs_push(form); +- vs_push(lex_env[0]); +- vs_push(lex_env[1]); +- vs_push(lex_env[2]); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- stack_cons(); ++ vs_push(list(3,lex_env[0],lex_env[1],lex_env[2])); + super_funcall(hookfun); + bds_unwind(old_bds_top); + return; +@@ -970,22 +973,12 @@ static void + call_applyhook(object fun) + { + object ah; +- object *v; + + ah = symbol_value(siVapplyhook); +- v = vs_base + 1; +- vs_push(Cnil); +- while (vs_top > v) +- stack_cons(); ++ Llist(); + vs_push(vs_base[0]); + vs_base[0] = fun; +- vs_push(lex_env[0]); +- vs_push(lex_env[1]); +- vs_push(lex_env[2]); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- stack_cons(); ++ vs_push(list(3,lex_env[0],lex_env[1],lex_env[2])); + super_funcall(ah); + } + +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -1130,8 +1130,7 @@ read_fasd1(int i, object *loc) + *loc=Cnil;return; + case DP(d_cons:) + read_fasd1(GET_OP(),&tem); +- *loc=make_cons(tem,Cnil); +- loc= &((*loc)->c.c_cdr); ++ collect(loc,make_cons(tem,Cnil)); + i=GET_OP(); + goto BEGIN; + case DP(d_list1:) i=1;goto READ_LIST; +@@ -1162,8 +1161,7 @@ read_fasd1(int i, object *loc) + read_fasd1(j,&tem); + DPRINTF("{Item=",(debug >= 2 ? pp(tem) : 0)); + DPRINTF("}",0); +- *loc=make_cons(tem,Cnil); +- loc= &((*loc)->c.c_cdr);}} ++ collect(loc,make_cons(tem,Cnil));}} + + case DP(d_delimiter:) + case DP(d_dot:) +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -1429,52 +1429,54 @@ LFD(Lmake_synonym_stream)() + vs_base[0] = x; + } + +-LFD(Lmake_broadcast_stream)() +-{ +- object x; +- int narg, i; +- +- narg = vs_top - vs_base; +- for (i = 0; i < narg; i++) +- if (type_of(vs_base[i]) != t_stream || +- !output_stream_p(vs_base[i])) +- cannot_write(vs_base[i]); +- vs_push(Cnil); +- for (i = narg; i > 0; --i) +- stack_cons(); +- x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm_broadcast; +- x->sm.sm_fp = NULL; +- x->sm.sm_buffer = 0; +- x->sm.sm_object0 = vs_base[0]; +- x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int = 0; +- x->sm.sm_flags=0; +- vs_base[0] = x; ++LFD(Lmake_broadcast_stream)() { ++ ++ object x; ++ int narg, i; ++ ++ narg = vs_top - vs_base; ++ for (i = 0; i < narg; i++) ++ if (type_of(vs_base[i]) != t_stream || ++ !output_stream_p(vs_base[i])) ++ cannot_write(vs_base[i]); ++ ++ Llist(); ++ ++ x = alloc_object(t_stream); ++ x->sm.sm_mode = (short)smm_broadcast; ++ x->sm.sm_fp = NULL; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = vs_base[0]; ++ x->sm.sm_object1 = OBJNULL; ++ x->sm.sm_int = 0; ++ x->sm.sm_flags=0; ++ vs_base[0] = x; ++ + } + +-LFD(Lmake_concatenated_stream)() +-{ +- object x; +- int narg, i; +- +- narg = vs_top - vs_base; +- for (i = 0; i < narg; i++) +- if (type_of(vs_base[i]) != t_stream || +- !input_stream_p(vs_base[i])) +- cannot_read(vs_base[i]); +- vs_push(Cnil); +- for (i = narg; i > 0; --i) +- stack_cons(); +- x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm_concatenated; +- x->sm.sm_fp = NULL; +- x->sm.sm_buffer = 0; +- x->sm.sm_object0 = vs_base[0]; +- x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int = 0; +- x->sm.sm_flags=0; +- vs_base[0] = x; ++LFD(Lmake_concatenated_stream)() { ++ ++ object x; ++ int narg, i; ++ ++ narg = vs_top - vs_base; ++ for (i = 0; i < narg; i++) ++ if (type_of(vs_base[i]) != t_stream || ++ !input_stream_p(vs_base[i])) ++ cannot_read(vs_base[i]); ++ ++ Llist(); ++ ++ x = alloc_object(t_stream); ++ x->sm.sm_mode = (short)smm_concatenated; ++ x->sm.sm_fp = NULL; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = vs_base[0]; ++ x->sm.sm_object1 = OBJNULL; ++ x->sm.sm_int = 0; ++ x->sm.sm_flags=0; ++ vs_base[0] = x; ++ + } + + LFD(Lmake_two_way_stream)() +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -543,7 +543,9 @@ mark_object1(object x) { + mark_object_address(&x->ht.ht_self[i].hte_key,i); + mark_object_address(&x->ht.ht_self[i].hte_value,i+1); + } ++ i=x->ht.ht_cache-x->ht.ht_self; + MARK_LEAF_DATA(x,x->ht.ht_self,x->ht.ht_size*sizeof(*x->ht.ht_self)); ++ if (x->ht.ht_cache) x->ht.ht_cache=x->ht.ht_self+i; + break; + + case t_array: +@@ -662,6 +664,7 @@ mark_object1(object x) { + break; + + case t_readtable: ++ mark_object(x->rt.rt_case); + if (x->rt.rt_self) { + for (i=0;irt.rt_self[i].rte_macro,i); +@@ -968,7 +971,7 @@ sweep_phase(void) { + tm = tm_of((enum type)v->type); + + p = pagetochar(page(v)); +- f = tm->tm_free; ++ f = FREELIST_TAIL(tm); + k = 0; + for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { + x = (object)p; +@@ -979,12 +982,13 @@ sweep_phase(void) { + continue; + } + +- SET_LINK(x,f); ++ SET_LINK(f,x); + make_free(x); + f = x; + k++; + } +- tm->tm_free = f; ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail = f; + tm->tm_nfree += k; + pagetoinfo(page(v))->in_use-=k; + +--- gcl-2.6.12.orig/o/hash.d ++++ gcl-2.6.12/o/hash.d +@@ -196,33 +196,28 @@ DEFUN_NEW("HASH-EQUAL",object,fShash_equ + + + struct htent * +-gethash(object key, object hashtable) { ++gethash(object key, object ht) { + +- enum httest htest; +- long hsize,j,s,q; +- struct htent *e,*first_objnull=NULL; +- object hkey; ++ long s,q; ++ struct htent *e,*ee,*first_open=NULL; + static struct htent dummy={OBJNULL,OBJNULL}; + +- if (!hashtable->ht.ht_size) +- return &dummy; +- +- htest = (enum httest)hashtable->ht.ht_test; +- hsize = hashtable->ht.ht_size; ++ if (ht->ht.ht_cache && ht->ht.ht_cache->hte_key==key) ++ return ht->ht.ht_cache; ++ ht->ht.ht_cache=NULL; + + #define eq(x,y) x==y + #define hash_loop(t_,i_) \ +- for (s=i_%hsize,q=hsize,e=first_objnull;s>=0;q=s,s=s?0:-1) \ +- for (j=s;jht.ht_self[j]; \ +- hkey = e->hte_key; \ ++ for (q=ht->ht.ht_size,s=i_%q;s>=0;q=s,s=s?0:-1) \ ++ for (e=ht->ht.ht_self,ee=e+q,e+=s;ehte_key; \ + if (hkey==OBJNULL) { \ +- if (e->hte_value==OBJNULL) return first_objnull ? first_objnull : e; \ +- if (!first_objnull) first_objnull=e; \ +- } else if (t_(key,hkey)) return e; \ ++ if (e->hte_value==OBJNULL) return first_open ? first_open : e; \ ++ if (!first_open) first_open=e; \ ++ } else if (t_(key,hkey)) return ht->ht.ht_cache=e; \ + } + +- switch (htest) { ++ switch (ht->ht.ht_test) { + case htt_eq: + hash_loop(eq,hash_eq(key)); + break; +@@ -237,7 +232,7 @@ gethash(object key, object hashtable) { + return &dummy; + } + +- return first_objnull ? first_objnull : (FEerror("No free spot in hashtable ~S.", 1, hashtable),&dummy); ++ return first_open ? first_open : (FEerror("No free spot in hashtable ~S.", 1, ht),&dummy); + + } + +@@ -290,7 +285,7 @@ object hashtable; + old = alloc_object(t_hashtable); + old->ht = hashtable->ht; + vs_push(old); +- hashtable->ht.ht_self = NULL; ++ hashtable->ht.ht_cache=hashtable->ht.ht_self = NULL; + hashtable->ht.ht_size = new_size; + if (type_of(hashtable->ht.ht_rhthresh) == t_fixnum) + hashtable->ht.ht_rhthresh = +@@ -365,6 +360,7 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRES + h->ht.ht_size = fix(size); + h->ht.ht_rhsize = rehash_size; + h->ht.ht_rhthresh = rehash_threshold; ++ h->ht.ht_cache=NULL; + h->ht.ht_nent = 0; + h->ht.ht_static = static!=Cnil ? 1 : 0; + h->ht.ht_self = NULL; +--- gcl-2.6.12.orig/o/list.d ++++ gcl-2.6.12/o/list.d +@@ -277,93 +277,78 @@ object on_stack_list_vector_new(int n,ob + return ans; + }*/ + +-object list_vector_new(int n,object first,va_list ap) +-{object ans,*p; ++object ++list_vector_new(int n,object first,va_list ap) { ++ ++ object ans,*p; + +- if (n == 0) return Cnil; +- ans = make_cons(first==OBJNULL ? va_arg(ap,object) : first,Cnil); +- p = & (ans->c.c_cdr); +- while (--n > 0) +- { *p = make_cons(va_arg(ap,object),Cnil); +- p = & ((*p)->c.c_cdr); +- } +- return ans;} ++ for (p=&ans;n-->0;first=OBJNULL) ++ collect(p,make_cons(first==OBJNULL ? va_arg(ap,object) : first,Cnil)); ++ *p=Cnil; ++ return ans; + ++} + +-/* clean this up */ +-/* static object on_stack_list(int n, ...) +-{va_list ap; +- object res; +- va_start(ap,n); +- res=on_stack_list_vector(n,ap); +- va_end(ap); +- return res; +-}*/ + #ifdef WIDE_CONS + #define maybe_set_type_of(a,b) set_type_of(a,b) + #else + #define maybe_set_type_of(a,b) + #endif + ++void ++free_check(void) { + ++ int n=tm_table[t_cons].tm_nfree,m; ++ object f=tm_table[t_cons].tm_free; ++ for (m=0;f!=OBJNULL;m++,f=OBJ_LINK(f)); ++ massert(n==m); ++} ++ + #define multi_cons(n_,next_,last_) \ +- ({static struct typemanager *_tm=tm_table+t_cons; \ +- object _lis=OBJNULL; \ +- \ +- if (n<=_tm->tm_nfree) { \ +- \ +- object _tail=_tm->tm_free; \ +- \ +- _lis=_tail; \ +- \ ++ ({_tm->tm_nfree -= n_; \ ++ for(_x=_tm->tm_free,_p=&_x;n_-->0;_p=&(*_p)->c.c_cdr) { \ ++ object _z=*_p; \ ++ pageinfo(_z)->in_use++; \ ++ maybe_set_type_of(_z,t_cons); \ ++ _z->c.c_cdr=OBJ_LINK(_z); \ ++ _z->c.c_car=next_; \ ++ } \ ++ _tm->tm_free=*_p; \ ++ *_p=SAFE_CDR(last_); \ ++ _x;}) ++ ++#define n_cons(n_,next_,last_) \ ++ ({fixnum _n=n_;object _x=Cnil,*_p; \ ++ static struct typemanager *_tm=tm_table+t_cons; \ ++ if (_n>=0) {/*FIXME vs_toptm_nfree -= n_; \ +- while (--n_) { \ +- pageinfo(_tail)->in_use++; \ +- maybe_set_type_of(_tail,t_cons); \ +- _tail->c.c_cdr=OBJ_LINK(_tail); \ +- _tail->c.c_car=next_; \ +- _tail=_tail->c.c_cdr; \ ++ if (_n<=_tm->tm_nfree) \ ++ _x=multi_cons(_n,next_,last_); \ ++ else { \ ++ for (_p=&_x;_n--;) \ ++ collect(_p,make_cons(next_,Cnil)); \ ++ *_p=SAFE_CDR(last_); \ + } \ +- _tm->tm_free=OBJ_LINK(_tail); \ +- pageinfo(_tail)->in_use++; \ +- maybe_set_type_of(_tail,t_cons); \ +- _tail->c.c_car=next_; \ +- _tail->c.c_cdr=SAFE_CDR(last_); \ +- \ + END_NO_INTERRUPT; \ + } \ +- _lis;}) +- +- +- +-object listqA(int a,int n,va_list ap) { +- +- object x,*p; +- +- if (n<=0) return Cnil; ++ _x;}) ++ ++object ++n_cons_from_x(fixnum n,object x) { + +- if ((x=multi_cons(n,va_arg(ap,object),a ? va_arg(ap,object) : Cnil))!=OBJNULL) +- return x; ++ return n_cons(n,({object _z=x->c.c_car;x=x->c.c_cdr;_z;}),Cnil); ++ ++} + +- CHECK_INTERRUPT; + +- p = vs_top; +- +- vs_push(Cnil); +- while(--n>=0) { +- *p=make_cons(va_arg(ap,object),Cnil); +- p= &((*p)->c.c_cdr); +- } +- if (a) +- *p=SAFE_CDR(va_arg(ap,object)); ++object ++listqA(int a,int n,va_list ap) { + +- return(vs_pop); ++ return n_cons(n,va_arg(ap,object),a ? va_arg(ap,object) : Cnil); + + } + +-object list(int n,...) { ++object list(fixnum n,...) { + + va_list ap; + object lis; +@@ -375,7 +360,7 @@ object list(int n,...) { + + } + +-object listA(int n,...) { ++object listA(fixnum n,...) { + + va_list ap; + object lis; +@@ -417,163 +402,63 @@ BEGIN: + object + append(object x, object y) { + +- object z; +- fixnum n; +- +- if (endp(x)) +- return(y); +- +- for (z=x,n=0;!endp(z);z=z->c.c_cdr,n++); +- if ((z=multi_cons(n,({object _t=x->c.c_car;x=x->c.c_cdr;_t;}),y))!=OBJNULL) +- return z; ++ return n_cons(length(x),({object _t=x->c.c_car;x=x->c.c_cdr;_t;}),y); + +- z = make_cons(Cnil, Cnil); +- vs_push(z); +- for (;;) { +- z->c.c_car = x->c.c_car; +- x = x->c.c_cdr; +- if (endp(x)) +- break; +- z->c.c_cdr = make_cons(Cnil, Cnil); +- z = z->c.c_cdr; +- } +- z->c.c_cdr = SAFE_CDR(y); +- return(vs_pop); + } + +- +- +-/* object */ +-/* append(x, y) */ +-/* object x, y; */ +-/* { */ +-/* object z; */ +- +-/* if (endp(x)) */ +-/* return(y); */ +-/* z = make_cons(Cnil, Cnil); */ +-/* vs_push(z); */ +-/* for (;;) { */ +-/* z->c.c_car = x->c.c_car; */ +-/* x = x->c.c_cdr; */ +-/* if (endp(x)) */ +-/* break; */ +-/* z->c.c_cdr = make_cons(Cnil, Cnil); */ +-/* z = z->c.c_cdr; */ +-/* } */ +-/* z->c.c_cdr = SAFE_CDR(y); */ +-/* return(vs_pop); */ +-/* } */ +- + /* + Copy_list(x) copies list x. + */ + object +-copy_list(x) +-object x; +-{ +- object y; +- +- if (type_of(x) != t_cons) +- return(x); +- y = make_cons(x->c.c_car, Cnil); +- vs_push(y); +- for (x = x->c.c_cdr; type_of(x) == t_cons; x = x->c.c_cdr) { +- y->c.c_cdr = make_cons(x->c.c_car, Cnil); +- y = y->c.c_cdr; +- } +- y->c.c_cdr = SAFE_CDR(x); +- return(vs_pop); ++copy_list(object x) { ++ object h,y; ++ ++ if (type_of(x) != t_cons) ++ return(x); ++ h=y=make_cons(x->c.c_car, Cnil); ++ for (x = x->c.c_cdr; type_of(x) == t_cons; x = x->c.c_cdr) { ++ y->c.c_cdr = make_cons(x->c.c_car, Cnil); ++ y=y->c.c_cdr; ++ } ++ y->c.c_cdr=SAFE_CDR(x); ++ return(h); + } + + /* + Copy_alist(x) copies alist x. + */ + static object +-copy_alist(x) +-object x; +-{ +- object y; ++copy_alist(object x) { + +- if (endp(x)) +- return(Cnil); +- y = make_cons(Cnil, Cnil); +- vs_push(y); +- for (;;) { +- y->c.c_car = make_cons(car(x->c.c_car), cdr(x->c.c_car)); +- x = x->c.c_cdr; +- if (endp(x)) +- break; +- y->c.c_cdr = make_cons(Cnil, Cnil); +- y = y->c.c_cdr; +- } +- return(vs_pop); ++ object h,y; ++ ++ if (endp(x)) ++ return(Cnil); ++ h=y=make_cons(Cnil, Cnil); ++ for (;;) { ++ y->c.c_car=make_cons(car(x->c.c_car), cdr(x->c.c_car)); ++ x=x->c.c_cdr; ++ if (endp(x)) ++ break; ++ y->c.c_cdr=make_cons(Cnil, Cnil); ++ y=y->c.c_cdr; ++ } ++ return(h); + } + +-/* +- Copy_tree(x) copies tree x +- and pushes the result onto vs. +-*/ +-static void +-copy_tree(x) +-object x; +-{ +- cs_check(x); +- +- if (type_of(x) == t_cons) { +- copy_tree(x->c.c_car); +- copy_tree(x->c.c_cdr); +- stack_cons(); +- } else +- vs_check_push(x); +-} +- +-/* /\* */ +-/* Subst(new, tree) pushes */ +-/* the result of substituting new in tree */ +-/* onto vs. */ +-/* *\/ */ +-/* static void */ +-/* subst(new, tree) */ +-/* object new, tree; */ +-/* { */ +-/* cs_check(new); */ +- +-/* if (TEST(tree)) */ +-/* vs_check_push(new); */ +-/* else if (type_of(tree) == t_cons) { */ +-/* subst(new, tree->c.c_car); */ +-/* subst(new, tree->c.c_cdr); */ +-/* stack_cons(); */ +-/* } else */ +-/* vs_check_push(tree); */ +-/* } */ +- +-/* static object */ +-/* subst1(object new, object tree) { */ +- +-/* if (TEST(tree)) */ +-/* return new; */ +-/* else if (type_of(tree) == t_cons) { */ +-/* object oa=tree->c.c_car,a=subst1(new,oa),od=tree->c.c_cdr,d=subst1(new,od); */ +-/* return a==oa && d==od ? tree : make_cons(a,d); */ +-/* } else */ +-/* return tree; */ +- +-/* } */ +- +-/* static object */ +-/* subst1qi(object new, object tree) { */ +- +-/* if (item_compared == tree) */ +-/* return new; */ +-/* else if (type_of(tree) == t_cons) { */ +-/* object oa=tree->c.c_car,a=subst1qi(new,oa),od=tree->c.c_cdr,d=subst1qi(new,od); */ +-/* return a==oa && d==od ? tree : make_cons(a,d); */ +-/* } else */ +-/* return tree; */ ++static object ++copy_tree(object x) { + +-/* } */ ++ object y; ++ ++ if (type_of(x) == t_cons) { ++ y=make_cons(Cnil,Cnil); ++ y->c.c_car=copy_tree(x->c.c_car); ++ y->c.c_cdr=copy_tree(x->c.c_cdr); ++ x=y; ++ } ++ return x; ++} + + /* + Nsubst(new, treep) stores +@@ -599,27 +484,22 @@ object new, *treep; + result of substituting tree by alist + onto vs. + */ +-static void +-sublis(alist, tree) +-object alist, tree; +-{ +- object x; +- cs_check(alist); +- ++static object ++sublis(object alist, object tree) { + +- for (x = alist; !endp(x); x = x->c.c_cdr) { +- item_compared = car(x->c.c_car); +- if (TEST(tree)) { +- vs_check_push(cdr(x->c.c_car)); +- return; +- } +- } +- if (type_of(tree) == t_cons) { +- sublis(alist, tree->c.c_car); +- sublis(alist, tree->c.c_cdr); +- stack_cons(); +- } else +- vs_check_push(tree); ++ object x; ++ cs_check(alist); ++ ++ for (x=alist;!endp(x);x=x->c.c_cdr) { ++ item_compared=car(x->c.c_car); ++ if (TEST(tree)) ++ return x->c.c_car->c.c_cdr; ++ } ++ if (type_of(tree) == t_cons) { ++ object a=sublis(alist,tree->c.c_car),d=sublis(alist,tree->c.c_cdr); ++ return (a==tree->c.c_car && d==tree->c.c_cdr) ? tree : make_cons(a,d); ++ } else ++ return tree; + } + + /* +@@ -777,7 +657,7 @@ DEFUN_NEW("TENTH",object,fLtenth,LISP,1, + LFD(Lcons)() { + + check_arg(2); +- stack_cons(); ++ vs_base[0]=make_cons(vs_base[0],vs_pop); + + } + +@@ -907,36 +787,28 @@ LFD(Llast)() { + + } + +-LFD(Llist)() +-{ +- vs_push(Cnil); +- while (vs_top > vs_base + 1) +- stack_cons(); +-} ++LFD(Llist)() { ++ ++ object *a; ++ ++ a=vs_base; ++ vs_base[0]=n_cons(vs_top-vs_base,*a++,Cnil); ++ vs_top=vs_base+1; + +-LFD(LlistA)() +-{ +- if (vs_top == vs_base) +- too_few_arguments(); +- while (vs_top > vs_base + 1) +- stack_cons(); + } +-/* static object copy_off_stack_tree(x) */ +-/* object x; */ +-/* {object *p; */ +-/* p = &x; */ +-/* TOP: */ +-/* if (type_of(*p) ==t_cons) */ +-/* { if(!inheap(*p)) */ +-/* *p=make_cons(copy_off_stack_tree((*p)->c.c_car),(*p)->c.c_cdr); */ +-/* else */ +-/* (*p)->c.c_car = copy_off_stack_tree((*p)->c.c_car); */ +-/* p = &((*p)->c.c_cdr); */ +-/* goto TOP;} */ +-/* return x; */ +-/* } */ + +- ++LFD(LlistA)() { ++ ++ object *a; ++ ++ if (vs_top == vs_base) ++ too_few_arguments(); ++ ++ a=vs_base; ++ vs_base[0]=n_cons(vs_top-vs_base-1,*a++,vs_head); ++ vs_top=vs_base+1; ++ ++} + + object on_stack_make_list(n) + int n; +@@ -957,23 +829,20 @@ int n; + goto TOP; + } + +-object make_list(n) +-int n; +-{object x =Cnil ; +- while (n-- > 0) +- x = make_cons(Cnil, x); +- return x;} ++object ++make_list(int n) { ++ ++ return n_cons(n,Cnil,Cnil); ++ ++} + + @(defun make_list (size &key initial_element &aux x) +- int i; + @ +- check_type_non_negative_integer(&size); +- if (type_of(size) != t_fixnum) +- FEerror("Cannot make a list of the size ~D.", 1, size); +- i = fix(size); +- while (i-- > 0) +- x = make_cons(initial_element, x); +- @(return x) ++ check_type_non_negative_integer(&size); ++ if (type_of(size) != t_fixnum) ++ FEerror("Cannot make a list of the size ~D.", 1, size); ++ x=n_cons(fix(size),initial_element,Cnil); ++ @(return x) + @) + + LFD(Lappend)() +@@ -1006,22 +875,19 @@ LFD(Lcopy_alist)() + LFD(Lcopy_tree)() + { + check_arg(1); +- copy_tree(vs_base[0]); +- vs_base[0] = vs_pop; ++ vs_base[0]=copy_tree(vs_base[0]); + } + + LFD(Lrevappend)() { +- object x, y; + +- check_arg(2); +- y = vs_pop; +- for (x = vs_base[0]; !endp(x); x = x->c.c_cdr) { +- vs_push(x->c.c_car); +- vs_push(y); +- stack_cons(); +- y = vs_pop; +- } +- vs_base[0] = y; ++ object x, y; ++ ++ check_arg(2); ++ y=vs_pop; ++ for (x=vs_base[0];!endp(x);x=x->c.c_cdr) ++ y=make_cons(x->c.c_car,y); ++ vs_base[0] = y; ++ + } + + object +@@ -1078,26 +944,19 @@ LFD(Lreconc)() { + } + + @(defun butlast (lis &optional (nn `make_fixnum(1)`)) +- int i; ++ int i; ++ object *p,x,y,z; + @ +- check_type_non_negative_integer(&nn); +- if (!listp(lis))/*FIXME checktype*/ +- FEwrong_type_argument(sLlist, lis); +- if (type_of(nn) != t_fixnum) +- @(return Cnil) +- for (i = 0; consp(lis); i++, lis = lis->c.c_cdr) +- vs_check_push(lis->c.c_car); +- if (i <= fix((nn))) { +- vs_top -= i; +- @(return Cnil) +- } +- vs_top -= fix((nn)); +- i -= fix((nn)); +- vs_push(Cnil); +- while (i-- > 0) +- stack_cons(); +- lis = vs_pop; +- @(return lis) ++ check_type_non_negative_integer(&nn); ++ if (!listp(lis))/*FIXME checktype*/ ++ FEwrong_type_argument(sLlist, lis); ++ if (type_of(nn) != t_fixnum) ++ @(return Cnil) ++ for (x=y=lis,i=0;ic.c_cdr); ++ for (p=&z;consp(y);x=x->c.c_cdr,y=y->c.c_cdr) ++ collect(p,make_cons(x->c.c_car,Cnil)); ++ *p=i ? Cnil : x; ++ @(return `z`) + @) + + @(defun nbutlast (lis &optional (nn `make_fixnum(1)`)) +@@ -1119,21 +978,20 @@ LFD(Lreconc)() { + @) + + LFD(Lldiff)() { +- fixnum i; +- object x; + +- check_arg(2); +- x = vs_base[0]; +- if (!listp(x))/*FIXME checktype*/ +- FEwrong_type_argument(sLlist, x); +- for (i = 0; consp(x) && x!=vs_base[1] ; i++, x = x->c.c_cdr) +- vs_check_push(x->c.c_car); /*FIXME but a segfault breaker at vs_limit*/ +- x=eql(x,vs_base[1]) ? Cnil : x; +- vs_check_push(x); +- while (i-- > 0) +- stack_cons(); +- vs_base[0] = vs_pop; +- vs_popp; ++ fixnum i; ++ object x,y,*p,z; ++ ++ check_arg(2); ++ x=vs_base[0]; ++ z=vs_pop; ++ if (!listp(x))/*FIXME checktype*/ ++ FEwrong_type_argument(sLlist, x); ++ for (p=&y,i=0;consp(x) && x!=z;i++,x=x->c.c_cdr) ++ collect(p,make_cons(x->c.c_car,Cnil)); ++ *p=eql(x,z) ? Cnil : x; ++ vs_base[0]=y; ++ + } + + LFD(Lrplaca)() +@@ -1187,18 +1045,15 @@ LFD(Lrplacd)() + PREDICATE(Lnsubst,Lnsubst_if,Lnsubst_if_not, 3) + + object +-sublis1(alist,tree,tst) +- object alist,tree; +- bool (*tst)(); +-{object v; +- for (v=alist ; v!=Cnil; v=v->c.c_cdr) +- { if ((*tst)(v->c.c_car->c.c_car ,tree)) +- return(v->c.c_car->c.c_cdr);} +- if (type_of(tree)==t_cons) +- {object ntree=make_cons(sublis1(alist,tree->c.c_car,tst), +- tree->c.c_cdr); +- ntree->c.c_cdr=sublis1(alist,ntree->c.c_cdr,tst); +- return ntree; ++sublis1(object alist,object tree,bool (*tst)()) { ++ ++ object v; ++ for (v=alist;v!=Cnil;v=v->c.c_cdr) { ++ if ((*tst)(v->c.c_car->c.c_car,tree)) ++ return(v->c.c_car->c.c_cdr);} ++ if (type_of(tree)==t_cons){ ++ object a=sublis1(alist,tree->c.c_car,tst),d=sublis1(alist,tree->c.c_cdr,tst); ++ return a==tree->c.c_car && d==tree->c.c_cdr ? tree : make_cons(a,d); + } + return tree; + } +@@ -1226,8 +1081,7 @@ check_alist(alist) + @ + protectTEST; + setupTEST(Cnil, test, test_not, key); +- sublis(alist, tree); +- tree = vs_pop; ++ tree=sublis(alist,tree); + restoreTEST; + @(return tree) + @) +@@ -1321,27 +1175,25 @@ LFD(Lacons)() + } + + @(defun pairlis (keys data &optional a_list) +- object *vp, k, d; ++ object k,d,y,z,*p; + @ +- vp = vs_top + 1; +- k = keys; +- d = data; +- while (!endp(k)) { +- if (endp(d)) +- FEerror( +- "The keys ~S and the data ~S are not of the same length", +- 2, keys, data); +- vs_check_push(make_cons(k->c.c_car, d->c.c_car)); +- k = k->c.c_cdr; +- d = d->c.c_cdr; +- } +- if (!endp(d)) +- FEerror("The keys ~S and the data ~S are not of the same length", +- 2, keys, data); +- vs_push(a_list); +- while (vs_top > vp) +- stack_cons(); +- @(return `vp[-1]`) ++ k=keys; ++ d=data; ++ p=&y; ++ while (!endp(k)) { ++ if (endp(d)) ++ FEerror("The keys ~S and the data ~S are not of the same length",2,keys,data); ++ z=make_cons(Cnil,Cnil); ++ z->c.c_car=make_cons(k->c.c_car,d->c.c_car); ++ collect(p,z); ++ k = k->c.c_cdr; ++ d = d->c.c_cdr; ++ } ++ if (!endp(d)) ++ FEerror("The keys ~S and the data ~S are not of the same length",2,keys,data); ++ *p=a_list; ++ vs_top=vs_base+1; ++ @(return `y`) + @) + + @(static defun assoc_or_rassoc (item a_list &key test test_not key) +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -91,8 +91,8 @@ $(DECL): $(HDIR)/make-decl.h $(INI_FILES + grab_defs: grab_defs.c + ${CC} $(OFLAGS) -o grab_defs grab_defs.c + +-wpool: wpool.c +- $(CC) $(CFLAGS) $(DEFS) -o $@ $< ++wpool: wpool.o ++ $(CC) $(LDFLAGS) -o $@ $< + + $(GCLIB): ${ALIB} + rm -f gcllib.a +--- gcl-2.6.12.orig/o/makefun.c ++++ gcl-2.6.12/o/makefun.c +@@ -6,12 +6,20 @@ + MakeAfun(addr,F_ARGD(min,max,flags,ARGTYPES(a,b,c,d)),0); + MakeAfun(addr,F_ARGD(2,3,NONE,ARGTYPES(OO,OO,OO,OO)),0); + */ ++ ++static int mv; ++ + object MakeAfun(object (*addr)(object,object), unsigned int argd, object data) +-{int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : t_afun); ++{ ++ ufixnum at=F_TYPES(argd)>>F_TYPE_WIDTH; ++ ufixnum ma=F_MIN_ARGS(argd); ++ ufixnum xa=F_MAX_ARGS(argd); ++ ufixnum rt=F_RESULT_TYPE(argd); ++ int type = (F_ARG_FLAGS_P(argd,F_requires_fun_passed) ? t_closure : (!at&&!rt&&ma==xa&&!mv ? t_sfun : t_afun)); + object x = alloc_object(type); + x->sfn.sfn_name = Cnil; + x->sfn.sfn_self = addr; +- x->sfn.sfn_argd = argd; ++ x->sfn.sfn_argd = type==t_sfun ? ma : argd; + if (type == t_closure) + { x->cl.cl_env = 0; + x->cl.cl_envdim=0;} +@@ -107,7 +115,7 @@ DEFUN_NEW("SET-KEY-STRUCT",object,fSset_ + } + + +-#define collect(top_,next_,val_) ({object _x=MMcons(val_,Cnil);\ ++#define mcollect(top_,next_,val_) ({object _x=MMcons(val_,Cnil);\ + if (top_==Cnil) top_=next_=_x; \ + else next_=next_->c.c_cdr=_x;}) + +@@ -125,23 +133,23 @@ put_fn_procls(object sym,fixnum argd,fix + for (i=0;i>=F_TYPE_WIDTH) + switch(maxargs!=minargs ? F_object : atypes & MASK_RANGE(0,F_TYPE_WIDTH)) { + case F_object: +- collect(ta,na,def); ++ mcollect(ta,na,def); + break; + case F_int: +- collect(ta,na,sLfixnum); ++ mcollect(ta,na,sLfixnum); + break; + case F_shortfloat: +- collect(ta,na,sLshort_float); ++ mcollect(ta,na,sLshort_float); + break; + case F_double_ptr: +- collect(ta,na,sLlong_float); ++ mcollect(ta,na,sLlong_float); + break; + default: + FEerror("Bad sfn declaration",0); + break; + } + if (maxargs!=minargs) +- collect(ta,na,sLA); ++ mcollect(ta,na,sLA); + putprop(sym,ta,sSproclaimed_arg_types); + ta=na=Cnil; + if (oneval) +@@ -188,15 +196,19 @@ LISP_makefun(char *strg, void *fn, unsig + void + SI_makefunm(char *strg, void *fn, unsigned int argd) + { object sym = make_si_ordinary(strg); +- fSfset(sym, fSmakefun(sym,fn,argd)); +- put_fn_procls(sym,argd,0,Ct,Ct); ++ mv=1; ++ fSfset(sym, fSmakefun(sym,fn,argd)); ++ mv=0; ++ put_fn_procls(sym,argd,0,Ct,Ct); + } + + void + LISP_makefunm(char *strg, void *fn, unsigned int argd) + { object sym = make_ordinary(strg); +- fSfset(sym, fSmakefun(sym,fn,argd)); +- put_fn_procls(sym,argd,0,Ct,Ct); ++ mv=1; ++ fSfset(sym, fSmakefun(sym,fn,argd)); ++ mv=0; ++ put_fn_procls(sym,argd,0,Ct,Ct); + } + + +--- gcl-2.6.12.orig/o/package.d ++++ gcl-2.6.12/o/package.d +@@ -849,17 +849,19 @@ FFN(Lpackage_shadowing_symbols)() + vs_base[0] = vs_base[0]->p.p_shadowings; + } + +-LFD(Llist_all_packages)() +-{ +- struct package *p; +- int i; ++LFD(Llist_all_packages)() { ++ ++ struct package *p; ++ object x,*l; ++ int i; ++ ++ check_arg(0); ++ ++ for (l=&x,p=pack_pointer,i=0;p!=NULL;p=p->p_link,i++) ++ collect(l,make_cons((object)p,Cnil)); ++ *l=Cnil; ++ vs_push(x); + +- check_arg(0); +- for (p = pack_pointer, i = 0; p != NULL; p = p->p_link, i++) +- vs_push((object)p); +- vs_push(Cnil); +- while (i-- > 0) +- stack_cons(); + } + + @(defun intern (strng &optional (p `current_package()`) &aux sym) +--- gcl-2.6.12.orig/o/predicate.c ++++ gcl-2.6.12/o/predicate.c +@@ -425,7 +425,7 @@ eql1(register object x,register object y + + /*x and y are not == and not Cnil and not immfix*/ + +- if (valid_cdr(x)||valid_cdr(y)||x->d.t!=y->d.t) return FALSE; ++ /* if (valid_cdr(x)||valid_cdr(y)||x->d.t!=y->d.t) return FALSE; */ + + switch (x->d.t) { + +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -41,6 +41,8 @@ int line_length = 72; + isLower((c)&0377) || (c) == ':') + + ++#define READ_TABLE_CASE (Vreadtable->s.s_dbind->rt.rt_case) ++ + #define mod(x) ((x)%Q_SIZE) + + +@@ -619,13 +621,113 @@ object coerce_big_to_string(object,int); + static bool + potential_number_p(object,int); + ++#define CASE_OF(x_) ({int _x=(x_);isUpper(_x) ? 1 : (isLower(_x) ? -1 : 0);}) ++ ++static int ++constant_case(object x) { ++ ++ fixnum i,j,jj; ++ ++ for (i=j=0;is.s_fillp;i++,j=j ? j : jj) ++ if (j*(jj=CASE_OF(x->s.s_self[i]))==-1) ++ return 0; ++ ++ return j; ++ ++} ++ ++static int ++all_dots(object x) { ++ ++ fixnum i; ++ ++ for (i=0;is.s_fillp;i++) ++ if (x->s.s_self[i]!='.') ++ return 0; ++ ++ return 1; ++ ++} ++ ++static int ++needs_escape (object x,int pp) { ++ ++ fixnum i; ++ char ch; ++ ++ if (!PRINTescape) ++ return 0; ++ ++ for (i=0;is.s_fillp;i++) ++ switch((ch=x->s.s_self[i])) { ++ case '(': ++ case ')': ++ case ':': ++ case '`': ++ case '\'': ++ case '"': ++ case ';': ++ case ',': ++ case '\n': ++ return 1; ++ case ' ': ++ if (!i) return 1; ++ default: ++ if ((READ_TABLE_CASE==sKupcase && isLower(ch)) || ++ (READ_TABLE_CASE==sKdowncase && isUpper(ch))) ++ return 1; ++ } ++ ++ if (pp) ++ if (potential_number_p(x, PRINTbase) || all_dots(x)) ++ return 1; ++ ++ return !x->s.s_fillp; ++ ++} ++ ++#define convertible_upper(c) ((READ_TABLE_CASE==sKupcase ||READ_TABLE_CASE==sKinvert)&& isUpper(c)) ++#define convertible_lower(c) ((READ_TABLE_CASE==sKdowncase||READ_TABLE_CASE==sKinvert)&& isLower(c)) ++ ++static void ++print_symbol_name_body(object x,int pp) { ++ ++ int i,j,fc,tc,lw,k,cc; ++ ++ cc=constant_case(x); ++ k=needs_escape(x,pp); ++ ++ if (k) ++ write_ch('|'); ++ ++ for (lw=i=0;is.s_fillp;i++) { ++ j = x->s.s_self[i]; ++ if (PRINTescape && (j == '|' || j == '\\')) ++ write_ch('\\'); ++ fc=convertible_upper(j) ? 1 : ++ (convertible_lower(j) ? -1 : 0); ++ tc=(READ_TABLE_CASE==sKinvert ? -cc : ++ (PRINTcase == sKupcase ? 1 : ++ (PRINTcase == sKdowncase ? -1 : ++ (PRINTcase == sKcapitalize ? (i==lw ? 1 : -1) : 0)))); ++ if (ispunct(j)||isspace(j)) lw=i+1; ++ j+=(tc*fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); ++ write_ch(j); ++ ++ } ++ ++ if (k) ++ write_ch('|'); ++ ++} ++ + void + write_object(x, level) + object x; + int level; + { + object r, y; +- int i, j, k,lw; ++ int i, j, k; + object *vp; + + cs_check(x); +@@ -797,117 +899,49 @@ int level; + break; + + case t_symbol: +- if (!PRINTescape) { +- for (lw = 0,i = 0; i < x->s.s_fillp; i++) { +- j = x->s.s_self[i]; +- if (isUpper(j)) { +- if (PRINTcase == sKdowncase || +- (PRINTcase == sKcapitalize && i!=lw)) +- j += 'a' - 'A'; +- } else if (!isLower(j)) +- lw = i + 1; +- write_ch(j); ++ { + +- } +- break; +- } +- if (x->s.s_hpack == Cnil) { +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('='); +- vp[1] = Ct; +- } +- } ++ if (PRINTescape) { ++ if (x->s.s_hpack == Cnil) { ++ if (PRINTcircle) { ++ for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++ if (x == *vp) { ++ if (vp[1] != Cnil) { ++ write_ch('#'); ++ write_decimal((vp-PRINTvs_top)/2+1); ++ write_ch('#'); ++ return; ++ } else { ++ write_ch('#'); ++ write_decimal((vp-PRINTvs_top)/2+1); ++ write_ch('='); ++ vp[1] = Ct; ++ } + } +- if (PRINTgensym) +- write_str("#:"); +- } else if (x->s.s_hpack == keyword_package) +- write_ch(':'); +- else if (PRINTpackage||find_symbol(x,current_package())!=x +- || intern_flag == 0) +- { +- k = 0; +- for (i = 0; +- i < x->s.s_hpack->p.p_name->st.st_fillp; +- i++) { +- j = x->s.s_hpack->p.p_name +- ->st.st_self[i]; +- if (to_be_escaped(j)) +- k++; +- } +- if (k > 0) +- write_ch('|'); +- for (lw = 0, i = 0; +- i < x->s.s_hpack->p.p_name->st.st_fillp; +- i++) { +- j = x->s.s_hpack->p.p_name +- ->st.st_self[i]; +- if (j == '|' || j == '\\') +- write_ch('\\'); +- if (k == 0) { +- if (isUpper(j)) { +- if (PRINTcase == sKdowncase || +- (PRINTcase == sKcapitalize && i!=lw)) +- j += 'a' - 'A'; +- } else if (!isLower(j)) +- lw = i + 1; +- } +- write_ch(j); +- } +- if (k > 0) +- write_ch('|'); +- if (find_symbol(x, x->s.s_hpack) != x) +- error("can't print symbol"); +- if (PRINTpackage || intern_flag == INTERNAL) +- write_str("::"); +- else if (intern_flag == EXTERNAL) +- write_ch(':'); +- else +- FEerror("Pathological symbol --- cannot print.", 0); + } +- k = 0; +- if (potential_number_p(x, PRINTbase)) +- k++; +- for (i = 0; i < x->s.s_fillp; i++) { +- j = x->s.s_self[i]; +- if (to_be_escaped(j)) +- k++; +- } +- for (i = 0; i < x->s.s_fillp; i++) +- if (x->s.s_self[i] != '.') +- goto NOT_DOT; +- k++; +- +- NOT_DOT: +- if (k > 0) +- write_ch('|'); +- for (lw = 0, i = 0; i < x->s.s_fillp; i++) { +- j = x->s.s_self[i]; +- if (j == '|' || j == '\\') +- write_ch('\\'); +- if (k == 0) { +- if (isUpper(j)) { +- if (PRINTcase == sKdowncase || +- (PRINTcase == sKcapitalize && i != lw)) +- j += 'a' - 'A'; +- } else if (!isLower(j)) +- lw = i + 1; +- } +- write_ch(j); +- } +- if (k > 0) +- write_ch('|'); +- break; ++ if (PRINTgensym) ++ write_str("#:"); ++ } else if (x->s.s_hpack == keyword_package) { ++ write_ch(':'); ++ } else if (PRINTpackage||find_symbol(x,current_package())!=x || !intern_flag) { ++ ++ print_symbol_name_body(x->s.s_hpack->p.p_name,0); ++ ++ if (find_symbol(x, x->s.s_hpack) != x) ++ error("can't print symbol"); ++ if (PRINTpackage || intern_flag == INTERNAL) ++ write_str("::"); ++ else if (intern_flag == EXTERNAL) ++ write_ch(':'); ++ else ++ FEerror("Pathological symbol --- cannot print.", 0); ++ ++ } + ++ } ++ print_symbol_name_body(x,1); ++ break; ++ } + case t_array: + { + int subscripts[ARANKLIM]; +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -695,10 +695,29 @@ BEGIN: + goto K; + else + break; +- } +- else if ('a' <= char_code(c) && char_code(c) <= 'z') +- c = code_char(char_code(c) - ('a' - 'A')); +- else if (char_code(c) == ':') { ++ } else { ++ ++ switch(char_code(c)) { ++ case '\b': ++ case '\t': ++ case '\n': ++ case '\r': ++ case '\f': ++ case ' ': ++ case '\177': ++ READER_ERROR(in,"Cannot read character"); ++ default: ++ break; ++ } ++ ++ if ('a' <= char_code(c) && char_code(c) <= 'z') { ++ if ('a' <= char_code(c) && char_code(c) <= 'z' && ++ (READtable->rt.rt_case==sKupcase || READtable->rt.rt_case==sKinvert)) ++ c = code_char(char_code(c) - ('a' - 'A')); ++ else if ('A' <= char_code(c) && char_code(c) <= 'Z' && ++ (READtable->rt.rt_case==sKdowncase || READtable->rt.rt_case==sKinvert)) ++ c = code_char(char_code(c) + ('a' - 'A')); ++ } else if (char_code(c) == ':') { + if (colon_type == 0) { + colon_type = 1; + colon = length; +@@ -707,6 +726,7 @@ BEGIN: + else + colon_type = -1; + /* Colon has appeared twice. */ ++ } + } + } + if (preserving_whitespace_flag || cat(c) != cat_whitespace) +@@ -807,46 +827,49 @@ SYMBOL: + } + + static void +-Lleft_parenthesis_reader() +-{ +- object in, x; +- object *p; ++Lleft_parenthesis_reader() { + +- check_arg(2); +- in = vs_base[0]; +- vs_head = Cnil; +- p = &vs_head; +- for (;;) { +- delimiting_char = code_char(')'); +- in_list_flag = TRUE; +- x = read_object(in); +- if (x == OBJNULL) +- goto ENDUP; +- if (dot_flag) { +- if (p == &vs_head) +- FEerror("A dot appeared after a left parenthesis.", 0); +- delimiting_char = code_char(')'); +- in_list_flag = TRUE; +- *p = SAFE_CDR(read_object(in)); +- if (dot_flag) +- FEerror("Two dots appeared consecutively.", 0); +- if (*p==OBJNULL) +- FEerror("Object missing after dot.", 0); +- delimiting_char = code_char(')'); +- in_list_flag = TRUE; +- if (read_object(in)!=OBJNULL) +- FEerror("Two objects after dot.",0); +- goto ENDUP; +- } +- vs_push(x); +- *p = make_cons(x, Cnil); +- vs_popp; +- p = &((*p)->c.c_cdr); +- } ++ object in, x; ++ object *p; ++ ++ check_arg(2); ++ in = vs_base[0]; ++ vs_top=vs_base+1; ++ p = &vs_head; ++ ++ for (;;) { ++ ++ delimiting_char = code_char(')'); ++ in_list_flag = TRUE; ++ ++ if ((x=read_object(in))==OBJNULL) { ++ *p=Cnil; ++ break; ++ } ++ ++ if (dot_flag) { ++ ++ if (p==&vs_head) READER_ERROR(in,"A dot appeared after a left parenthesis."); ++ ++ delimiting_char = code_char(')'); ++ in_list_flag = TRUE; ++ *p=SAFE_CDR(read_object(in)); ++ ++ if (dot_flag) READER_ERROR(in,"Two dots appeared consecutively."); ++ if (*p==OBJNULL) READER_ERROR(in,"Object missing after dot."); ++ ++ delimiting_char = code_char(')'); ++ in_list_flag = TRUE; ++ if (read_object(in)!=OBJNULL) READER_ERROR(in,"Two objects after dot."); ++ ++ break; ++ ++ } ++ ++ collect(p,make_cons(x,Cnil)); ++ ++ } + +-ENDUP: +- vs_base[0] = vs_pop; +- return; + } + + +@@ -959,13 +982,8 @@ static void + Lsingle_quote_reader() + { + check_arg(2); +- vs_popp; +- vs_push(sLquote); +- vs_push(read_object(vs_base[0])); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- vs_base[0] = vs_pop; ++ vs_base[0] = list(2,sLquote,read_object(vs_base[0])); ++ vs_top=vs_base+1; + } + + static void +@@ -1111,14 +1129,8 @@ Lsharp_single_quote_reader() + check_arg(3); + if(vs_base[2] != Cnil && !READsuppress) + extra_argument('#'); +- vs_popp; +- vs_popp; +- vs_push(sLfunction); +- vs_push(read_object(vs_base[0])); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- vs_base[0] = vs_pop; ++ vs_base[0] = list(2,sLfunction,read_object(vs_base[0])); ++ vs_top=vs_base+1; + } + + #define QUOTE 1 +@@ -1163,20 +1175,7 @@ Lsharp_left_parenthesis_reader() + } + goto L; + } +- vs_push(siScomma); +- vs_push(sLapply); +- vs_push(sLquote); +- vs_push(sLvector); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- vs_push(vs_base[2]); +- vs_push(Cnil); +- stack_cons(); +- stack_cons(); +- stack_cons(); +- stack_cons(); +- vs_base = vs_top - 1; ++ vs_base[0]=list(4,siScomma,sLapply,list(2,sLquote,sLvector),vs_base[2]); + return; + } + vsp = vs_top; +@@ -1633,6 +1632,7 @@ object from, to; + rtab[i].rte_dtab[j] + = from->rt.rt_self[i].rte_dtab[j]; + } ++ to->rt.rt_case=from->rt.rt_case; + vs_reset; + END_NO_INTERRUPT;} + return(to); +@@ -1758,8 +1758,7 @@ READ: + x = read_object_recursive(strm); + if (x == OBJNULL) + break; +- *p = make_cons(x, Cnil); +- p = &((*p)->c.c_cdr); ++ collect(p,make_cons(x,Cnil)); + } + if (recursivep == Cnil) { + if (sSAsharp_eq_contextA->s.s_dbind!=Cnil) +@@ -2181,6 +2180,18 @@ LFD(Lreadtablep)() + @(return Ct) + @) + ++DEFUN_NEW("READTABLE-CASE",object,fLreadtable_case,LISP,1,1,NONE,OO,OO,OO,OO,(object rt),"") { ++ check_type_readtable_no_default(&rt); ++ RETURN1(rt->rt.rt_case); ++} ++ ++DEFUN_NEW("SET-READTABLE-CASE",object,fSset_readtable_case,SI,2,2,NONE,OO,OO,OO,OO,(object rt,object cas),"") { ++ check_type_readtable_no_default(&rt); ++ if (cas!=sKupcase && cas!=sKdowncase && cas!=sKpreserve && cas!=sKinvert) ++ TYPE_ERROR(cas,list(5,sLmember,sKupcase,sKdowncase,sKpreserve,sKinvert)); ++ RETURN1(rt->rt.rt_case=cas); ++} ++ + @(static defun get_dispatch_macro_character (dspchr subchr + &optional (rdtbl `current_readtable()`)) + @ +@@ -2348,6 +2359,13 @@ gcl_init_read() + + gcl_init_backq(); + ++ sKupcase = make_keyword("UPCASE"); ++ sKdowncase = make_keyword("DOWNCASE"); ++ sKpreserve = make_keyword("PRESERVE"); ++ sKinvert = make_keyword("INVERT"); ++ ++ standard_readtable->rt.rt_case=sKupcase; ++ + Vreadtable + = make_special("*READTABLE*", + copy_readtable(standard_readtable, Cnil)); +--- gcl-2.6.12.orig/o/reference.c ++++ gcl-2.6.12/o/reference.c +@@ -73,18 +73,14 @@ LFD(Lsymbol_function)(void) + if (type_of(sym) != t_symbol) + not_a_symbol(sym); + if (sym->s.s_sfdef != NOT_SPECIAL) { +- vs_push(make_fixnum((long)(sym->s.s_sfdef))); +- vs_base[0] = sLspecial; +- stack_cons(); +- return; ++ vs_base[0]=make_cons(sLspecial,make_fixnum((long)(sym->s.s_sfdef))); ++ return; + } + if (sym->s.s_gfdef==OBJNULL) + FEundefined_function(sym); + if (sym->s.s_mflag) { +- vs_push(sym->s.s_gfdef); +- vs_base[0] = sSmacro; +- stack_cons(); +- return; ++ vs_base[0]=make_cons(sSmacro,sym->s.s_gfdef); ++ return; + } + vs_base[0] = sym->s.s_gfdef; + } +--- gcl-2.6.12.orig/o/sequence.d ++++ gcl-2.6.12/o/sequence.d +@@ -205,16 +205,7 @@ E: + } + if (e < 0) + @(return `copy_list(sequence)`) +- for (i = 0; i < e; i++) { +- if (type_of(sequence) != t_cons) +- goto ILLEGAL_START_END; +- vs_check_push(sequence->c.c_car); +- sequence = sequence->c.c_cdr; +- } +- vs_push(Cnil); +- while (e-- > 0) +- stack_cons(); +- x = vs_pop; ++ x=n_cons_from_x(e,sequence); + @(return x) + + case t_vector: +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -165,7 +165,7 @@ sgc_sweep_phase(void) { + tm = tm_of((enum type)v->type); + + p = pagetochar(page(v)); +- f = tm->tm_free; ++ f = FREELIST_TAIL(tm); + k = 0; + size=tm->tm_size; + +@@ -189,7 +189,7 @@ sgc_sweep_phase(void) { + + /* it is ok to free x */ + +- SET_LINK(x,f); ++ SET_LINK(f,x); + make_free(x); + #ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT; +@@ -198,7 +198,8 @@ sgc_sweep_phase(void) { + k++; + + } +- tm->tm_free = f; ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail = f; + tm->tm_nfree += k; + v->in_use-=k; + +@@ -674,34 +675,38 @@ sgc_start(void) { + contain the others */ + for (i= t_start; i < t_contiguous ; i++) + if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) { +- object f=tm->tm_free ,x,y,next; ++ object f=tm->tm_free,xf,yf; ++ struct freelist x,y;/*the f_link heads have to be separated on the stack*/ + fixnum count=0; +- x=y=OBJNULL; + ++ xf=PHANTOM_FREELIST(x.f_link); ++ yf=PHANTOM_FREELIST(y.f_link); + while (f!=OBJNULL) { +- next=OBJ_LINK(f); + #ifdef SDEBUG + if (!is_free(f)) + printf("Not FREE in freelist f=%d",f); + #endif + if (pageinfo(f)->sgc_flags&SGC_PAGE_FLAG) { +- SET_LINK(f,x); ++ SET_LINK(xf,f); + #ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_RECENT; + #endif +- x=f; ++ xf=f; + count++; + } else { +- SET_LINK(f,y); ++ SET_LINK(yf,f); + #ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_NORMAL; + #endif +- y=f; ++ yf=f; + } +- f=next; ++ f=OBJ_LINK(f); + } +- tm->tm_free = x; +- tm->tm_alt_free = y; ++ SET_LINK(xf,OBJNULL); ++ tm->tm_free = OBJ_LINK(&x); ++ tm->tm_tail = xf; ++ SET_LINK(yf,OBJNULL); ++ tm->tm_alt_free = OBJ_LINK(&y); + tm->tm_alt_nfree = tm->tm_nfree - count; + tm->tm_nfree=count; + } +@@ -853,38 +858,21 @@ sgc_quit(void) { + for (i= t_start; i < t_contiguous ; i++) + + if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc)) { +- +- object f,y; +- +- f=tm->tm_free; +- if (f==OBJNULL) +- tm->tm_free=tm->tm_alt_free; +- else { +- /* tack the alt_free onto the end of free */ +-#ifdef SDEBUG +- fixnum count=0; +- f=tm->tm_free; +- while(y= (object) F_LINK(f)) { +- if(y->d.s != SGC_RECENT) +- printf("[bad %d]",y); +- count++; f=y; ++ ++ object n=tm->tm_free,o=tm->tm_alt_free,f=PHANTOM_FREELIST(tm->tm_free); ++ ++ for (;n!=OBJNULL && o!=OBJNULL;) ++ if (o!=OBJNULL && (n==OBJNULL || otm_alt_free) +- while(y= F_LINK(f)) { +- if(y->d.s != SGC_NORMAL) +- printf("[alt_bad %d]",y); +- count++; f=y; +- } +- +-#endif +- f=tm->tm_free; +- while((y= (object) F_LINK(f))!=OBJNULL) +- f=y; +- F_LINK(f)= (long)(tm->tm_alt_free); +- } +- /* tm->tm_free has all of the free objects */ ++ SET_LINK(f,OBJNULL); ++ tm->tm_tail=f; + tm->tm_nfree += tm->tm_alt_nfree; + tm->tm_alt_nfree = 0; + tm->tm_alt_free = OBJNULL; +--- gcl-2.6.12.orig/o/structure.c ++++ gcl-2.6.12/o/structure.c +@@ -182,22 +182,19 @@ object + structure_to_list(object x) + { + +- object *p, s; +- struct s_data *def=S_DATA(x->str.str_def); +- int i, n; +- +- s = def->slot_descriptions; +- vs_push(def->name); +- vs_push(Cnil); +- p = &vs_head; +- for (i=0, n=def->length; !endp(s)&&ic.c_cdr, i++) { +- *p = make_cons(car(s->c.c_car), Cnil); +- p = &((*p)->c.c_cdr); +- *p = make_cons(structure_ref(x,x->str.str_def,i), Cnil); +- p = &((*p)->c.c_cdr); +- } +- stack_cons(); +- return(vs_pop); ++ object *p,s,v; ++ struct s_data *def=S_DATA(x->str.str_def); ++ int i,n; ++ ++ s=def->slot_descriptions; ++ for (p=&v,i=0,n=def->length;!endp(s)&&ic.c_cdr,i++) { ++ collect(p,make_cons(car(s->c.c_car),Cnil)); ++ collect(p,make_cons(structure_ref(x,x->str.str_def,i),Cnil)); ++ } ++ *p=Cnil; ++ ++ return make_cons(def->name,v); ++ + } + + LFD(siLmake_structure)(void) +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -169,9 +169,8 @@ DEF_ORDINARY("DIRECTORY",sKdirectory,KEY + DEF_ORDINARY("LINK",sKlink,KEYWORD,""); + DEF_ORDINARY("FILE",sKfile,KEYWORD,""); + +-DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- +- struct stat ss; ++static int ++stat_internal(object x,struct stat *ssp) { + + if (type_of(x)==t_string) { + +@@ -180,19 +179,43 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N + #ifdef __MINGW32__ + {char *p=FN1+strlen(FN1)-1;for (;p>FN1 && *p=='/';p--) *p=0;} + #endif +- if (lstat(FN1,&ss)) +- RETURN1(Cnil); ++ if (lstat(FN1,ssp)) ++ return 0; + } else if ((x=file_stream(x))!=Cnil&&x->sm.sm_fp) { +- if (fstat(fileno(x->sm.sm_fp),&ss)) +- RETURN1(Cnil); ++ if (fstat(fileno(x->sm.sm_fp),ssp)) ++ return 0; + } else +- RETURN1(Cnil); ++ return 0; ++ return 1; ++} ++ ++static object ++stat_mode_key(struct stat *ssp) { + +- RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : +- (S_ISLNK(ss.st_mode) ? sKlink : sKfile), +- make_fixnum(ss.st_size), +- make_fixnum(ss.st_mtime), +- make_fixnum(ss.st_uid)); ++ return S_ISDIR(ssp->st_mode) ? sKdirectory : (S_ISLNK(ssp->st_mode) ? sKlink : sKfile); ++ ++} ++ ++DEFUN_NEW("STAT1",object,fSstat1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ struct stat ss; ++ ++ RETURN1(stat_internal(x,&ss) ? stat_mode_key(&ss) : Cnil); ++ ++} ++ ++ ++DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ struct stat ss; ++ ++ if (stat_internal(x,&ss)) ++ RETURN4(stat_mode_key(&ss), ++ make_fixnum(ss.st_size), ++ make_fixnum(ss.st_mtime), ++ make_fixnum(ss.st_uid)); ++ else ++ RETURN1(Cnil); + + } + +--- gcl-2.6.12.orig/o/wpool.c ++++ gcl-2.6.12/o/wpool.c +@@ -3,7 +3,7 @@ + #define NO_PRELINK_UNEXEC_DIVERSION + char *rb_end=NULL,*rb_start=NULL,*heap_end=NULL; + void *data_start=NULL; +-int use_pool=1; ++int multiprocess_memory_pool=1; + + #include "include.h" + #include "page.h" +@@ -20,9 +20,9 @@ assert_error(const char *a,unsigned l,co + int + main(int argc,char * argv[],char * envp[]) { + +- int s; ++ int s=3; + +- sscanf(argv[1],"%d",&s); ++ if (argc>1) sscanf(argv[1],"%d",&s); + open_pool(); + for (;;) { + lock_pool(); +--- gcl-2.6.12.orig/pcl/sys-proclaim.lisp ++++ gcl-2.6.12/pcl/sys-proclaim.lisp +@@ -2,402 +2,1009 @@ + (COMMON-LISP::IN-PACKAGE "PCL") + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ PCL::NON-NEGATIVE-FIXNUM) ++ PCL::CACHE-SIZE PCL::CACHE-MASK PCL::CACHE-NLINES ++ PCL::CACHE-MAX-LOCATION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ PCL::COMPILE-LAMBDA-DEFERRED ++ PCL::EARLY-SLOT-DEFINITION-LOCATION PCL::FGEN-SYSTEM ++ PCL::EARLY-CLASS-PRECEDENCE-LIST PCL::MAKE-CLASS-EQ-PREDICATE ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS PCL::USE-CACHING-DFUN-P ++ WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE ++ PCL::SFUN-P PCL::INTERN-EQL-SPECIALIZER ++ PCL::ACCESSOR-DFUN-INFO-P WALKER::ENV-WALK-FORM ++ PCL::ARG-INFO-NUMBER-OPTIONAL PCL::TWO-CLASS-ACCESSOR-TYPE ++ PCL::FREE-CACHE PCL::SHOW-DFUN-COSTS PCL::CHECKING-CACHE ++ PCL::EARLY-GF-P PCL::EARLY-COLLECT-CPL PCL::NO-METHODS-CACHE ++ PCL::EXTRACT-PARAMETERS PCL::DEFAULT-CONSTANTP ++ PCL::PARSE-SPECIALIZERS ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION ++ PCL::DFUN-INFO-P PCL::CLASS-PRECEDENCE-DESCRIPTION-P ++ PCL::%FBOUNDP PCL::ONE-INDEX-DFUN-INFO-INDEX ++ PCL::ONE-CLASS-CACHE PCL::DEFAULT-STRUCTURE-INSTANCE-P ++ PCL::CONSTANT-VALUE-CACHE PCL::STRUCTURE-SVUC-METHOD ++ PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P ++ PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P ++ PCL::STRUCTURE-SLOTD-WRITER-FUNCTION PCL::CCLOSUREP ++ PCL::COUNT-DFUN PCL::COMPUTE-STD-CPL-PHASE-2 ++ PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME ++ PCL::EARLY-SLOT-DEFINITION-NAME PCL::MAP-SPECIALIZERS ++ PCL::MAKE-CONSTANT-FUNCTION PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P ++ PCL::DEFAULT-TEST-CONVERTER ++ PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::TWO-CLASS-INDEX ++ PCL::CACHE-P PCL::ARG-INFO-PRECEDENCE ++ PCL::STRUCTURE-SLOTD-INIT-FORM PCL::INITIAL-P ++ PCL::EXTRACT-REQUIRED-PARAMETERS PCL::%STD-INSTANCE-WRAPPER ++ PCL::FUNCTION-PRETTY-ARGLIST PCL::INTERN-FUNCTION-NAME ++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST ++ PCL::FLUSH-CACHE-VECTOR-INTERNAL PCL::TWO-CLASS-P ++ PCL::CHECK-CACHE PCL::RESET-INITIALIZE-INFO ++ PCL::ONE-INDEX-DFUN-INFO-P PCL::LEGAL-CLASS-NAME-P ++ PCL::UPDATE-PV-TABLE-CACHE-INFO ++ PCL::RESET-CLASS-INITIALIZE-INFO PCL::DISPATCH-P ++ PCL::%STD-INSTANCE-SLOTS PCL::SETFBOUNDP PCL::LOOKUP-FGEN ++ PCL::MAKE-INITFUNCTION PCL::FORCE-CACHE-FLUSHES ++ PCL::COMPLICATED-INSTANCE-CREATION-METHOD ++ PCL::NET-TEST-CONVERTER WALKER::ENV-DECLARATIONS ++ SYSTEM::%STRUCTURE-NAME PCL::GMAKUNBOUND PCL::TWO-CLASS-CACHE ++ PCL::STRUCTURE-TYPE PCL::CPD-CLASS PCL::CPD-AFTER ++ PCL::FAST-METHOD-CALL-P PCL::FGEN-GENERATOR-LAMBDA ++ PCL::CHECKING-FUNCTION PCL::DEFAULT-CONSTANT-CONVERTER ++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 ++ PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL PCL::EARLY-METHOD-CLASS ++ PCL::BUILT-IN-WRAPPER-OF PCL::EXPAND-SHORT-DEFCOMBIN ++ PCL::WRAPPER-OF ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION ++ PCL::PV-TABLEP PCL::EARLY-CLASS-NAME-OF ++ PCL::GET-MAKE-INSTANCE-FUNCTION PCL::ARG-INFO-KEY/REST-P ++ PCL::MAKE-EQL-PREDICATE PCL::STRUCTURE-SLOTD-READER-FUNCTION ++ PCL::CACHING-DFUN-INFO PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE ++ PCL::N-N-ACCESSOR-TYPE PCL::FAST-METHOD-CALL-PV-CELL ++ PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION ++ PCL::EXTRACT-SPECIALIZER-NAMES PCL::MAKE-TYPE-PREDICATE ++ PCL::GET-CACHE-VECTOR PCL::SORT-SLOTS ++ PCL::DEFAULT-STRUCTURE-TYPE SYSTEM::%COMPILED-FUNCTION-NAME ++ PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS WALKER::ENV-LOCK ++ PCL::ONE-INDEX-DFUN-INFO-CACHE PCL::ONE-INDEX-P ++ PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION ++ PCL::STANDARD-SVUC-METHOD PCL::MAKE-FUNCTION-INLINE ++ PCL::ALLOCATE-CACHE-VECTOR PCL::SLOT-BOUNDP-SYMBOL ++ PCL::METHOD-CALL-P PCL::STD-INSTANCE-P ++ PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::FUNCALLABLE-INSTANCE-P ++ PCL::ECD-CANONICAL-SLOTS PCL::GET-BUILT-IN-CLASS-SYMBOL ++ PCL::FREE-CACHE-VECTOR PCL::GF-INFO-STATIC-C-A-M-EMF ++ PCL::EARLY-GF-NAME PCL::UPDATE-CLASS-CAN-PRECEDE-P ++ PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P ++ PCL::ACCESSOR-DFUN-INFO-CACHE PCL::ARG-INFO-VALID-P ++ PCL::ONE-CLASS-INDEX WALKER::GET-WALKER-TEMPLATE ++ PCL::GFS-OF-TYPE PCL::N-N-P PCL::METHOD-CALL-CALL-METHOD-ARGS ++ PCL::BOOTSTRAP-CLASS-PREDICATES PCL::MAKE-INITIAL-DFUN ++ PCL::ONE-CLASS-WRAPPER0 PCL::ECD-OTHER-INITARGS ++ PCL::TWO-CLASS-WRAPPER1 PCL::MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::FUNCTION-RETURNING-T PCL::STRUCTURE-SLOTD-TYPE ++ PCL::ARG-INFO-APPLYP PCL::ECD-SUPERCLASS-NAMES ++ PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME ++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION ++ PCL::FGEN-GENSYMS PCL::EARLY-METHOD-STANDARD-ACCESSOR-P ++ PCL::DEFAULT-METHOD-ONLY-CACHE WALKER::ENV-LEXICAL-VARIABLES ++ PCL::ECD-CLASS-NAME PCL::GET-MAKE-INSTANCE-FUNCTIONS ++ PCL::EARLY-CLASS-DEFINITION PCL::ECD-METACLASS ++ PCL::UNDEFMETHOD-1 PCL::MAKE-CALL-METHODS ++ PCL::METHOD-LL->GENERIC-FUNCTION-LL PCL::SORT-CALLS ++ ITERATE::VARIABLES-FROM-LET PCL::GF-LAMBDA-LIST ++ PCL::INITIALIZE-INFO-KEY PCL::EARLY-CLASS-DIRECT-SUBCLASSES ++ PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE ++ PCL::MAKE-PERMUTATION-VECTOR PCL::EXTRACT-LAMBDA-LIST ++ PCL::CONSTANT-VALUE-DFUN-INFO PCL::DNET-METHODS-P ++ PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME ++ PCL::UPDATE-GFS-OF-CLASS PCL::SLOT-VECTOR-SYMBOL ++ PCL::COMPUTE-MCASE-PARAMETERS PCL::GBOUNDP ++ PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::CONSTANT-SYMBOL-P ++ PCL::CPD-SUPERS PCL::DEFAULT-METHOD-ONLY-P ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::CACHE-OWNER PCL::FAST-INSTANCE-BOUNDP-P ++ PCL::INITIALIZE-INFO-WRAPPER ++ PCL::INITIALIZE-INFO-CACHED-VALID-P PCL::EVAL-FORM ++ PCL::DEFAULT-STRUCTUREP PCL::FUNCTION-RETURNING-NIL ++ PCL::ONE-CLASS-P PCL::ARG-INFO-KEYWORDS ++ PCL::EARLY-CLASS-SLOTDS PCL::GET-PV-CELL-FOR-CLASS ++ PCL::ONE-CLASS-ACCESSOR-TYPE PCL::GENERIC-CLOBBERS-FUNCTION ++ PCL::DFUN-INFO-CACHE PCL::MAKE-PV-TABLE-TYPE-DECLARATION ++ PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::CLASS-FROM-TYPE ++ PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST ++ PCL::EARLY-METHOD-LAMBDA-LIST ++ PCL::EARLY-COLLECT-DEFAULT-INITARGS ++ PCL::COMPILE-LAMBDA-UNCOMPILED ++ PCL::INITIALIZE-INFO-CACHED-RI-VALID-P PCL::STRUCTURE-TYPE-P ++ PCL::%SYMBOL-FUNCTION PCL::MAKE-CALLS-TYPE-DECLARATION ++ PCL::SLOT-READER-SYMBOL PCL::KEYWORD-SPEC-NAME ++ PCL::FIND-CYCLE-REASONS PCL::UPDATE-ALL-C-A-M-GF-INFO ++ PCL::INITIALIZE-INFO-P ++ PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P ++ PCL::INITIAL-DISPATCH-CACHE PCL::CACHING-CACHE ++ PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS ++ PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST ++ PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::CONSTANT-VALUE-P ++ PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL PCL::EARLY-CLASS-SLOTS ++ PCL::UPDATE-C-A-M-GF-INFO PCL::GDEFINITION ++ PCL::ARG-INFO-LAMBDA-LIST PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL ++ PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION ++ PCL::MAKE-PV-TYPE-DECLARATION ++ PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P PCL::DISPATCH-CACHE ++ PCL::ONE-INDEX-ACCESSOR-TYPE ++ PCL::INITIALIZE-INFO-CACHED-CONSTANTS PCL::NO-METHODS-P ++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION ++ PCL::CACHING-DFUN-COST PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE ++ PCL::COMPUTE-CLASS-SLOTS PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE ++ PCL::GF-INFO-FAST-MF-P PCL::GF-INFO-C-A-M-EMF-STD-P ++ PCL::FGEN-TEST PCL::STRUCTURE-SLOTD-NAME PCL::CLASS-PREDICATE ++ PCL::STRUCTURE-SLOT-BOUNDP PCL::EARLY-CLASS-NAME ++ PCL::LIST-LARGE-CACHE PCL::ONE-INDEX-CACHE ++ PCL::SYMBOL-PKG-NAME PCL::INITIAL-CACHE ++ PCL::UNENCAPSULATED-FDEFINITION PCL::STORE-FGEN ++ PCL::FINAL-ACCESSOR-DFUN-TYPE ++ PCL::INITIALIZE-INFO-CACHED-NEW-KEYS PCL::TYPE-CLASS ++ PCL::%CCLOSURE-ENV PCL::INITIALIZE-INFO-BOUND-SLOTS ++ PCL::GF-DFUN-CACHE PCL::EXPAND-LONG-DEFCOMBIN ++ PCL::FGEN-GENERATOR PCL::DFUN-ARG-SYMBOL ++ PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST ++ PCL::EARLY-METHOD-QUALIFIERS ++ WALKER::VARIABLE-GLOBALLY-SPECIAL-P COMMON-LISP::CLASS-OF ++ PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION ++ PCL::GET-SETF-FUNCTION-NAME PCL::ARG-INFO-P ++ WALKER::ENV-WALK-FUNCTION PCL::LIST-DFUN ++ PCL::CHECK-WRAPPER-VALIDITY PCL::ARG-INFO-METATYPES ++ PCL::EXPAND-MAKE-INSTANCE-FORM PCL::STRUCTURE-OBJECT-P ++ PCL::COMPUTE-LINE-SIZE PCL::CANONICAL-SLOT-NAME ++ PCL::INITIAL-DISPATCH-P PCL::NEXT-WRAPPER-FIELD ++ PCL::WRAPPER-FIELD PCL::WRAPPER-FOR-STRUCTURE ++ PCL::METHOD-FUNCTION-PV-TABLE PCL::COPY-CACHE PCL::ECD-SOURCE ++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::UNPARSE-SPECIALIZERS PCL::CHECKING-P ++ PCL::FORMAT-CYCLE-REASONS PCL::N-N-CACHE ++ PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION ++ PCL::MAP-ALL-GENERIC-FUNCTIONS PCL::METHOD-FUNCTION-METHOD ++ PCL::UPDATE-GF-INFO PCL::ARG-INFO-NKEYS ++ PCL::TWO-CLASS-WRAPPER0 PCL::GF-DFUN-INFO PCL::ONE-INDEX-INDEX ++ PCL::EARLY-COLLECT-SLOTS PCL::CACHING-P ++ PCL::METHOD-FUNCTION-PLIST PCL::SLOT-WRITER-SYMBOL ++ PCL::FAST-METHOD-CALL-ARG-INFO PCL::INTERNED-SYMBOL-P ++ ITERATE::SEQUENCE-ACCESSOR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ PCL::LIST-LARGE-CACHES ++ PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD ++ COMMON-LISP::INVALID-METHOD-ERROR ++ COMMON-LISP::METHOD-COMBINATION-ERROR)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| ++ PCL::|__si::MAKE-TWO-CLASS| PCL::FALSE PCL::MAKE-PV-TABLE ++ PCL::|__si::MAKE-DISPATCH| PCL::MAKE-INITIALIZE-INFO ++ PCL::|__si::MAKE-PV-TABLE| PCL::MAKE-FAST-INSTANCE-BOUNDP ++ PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| ++ WALKER::UNBOUND-LEXICAL-FUNCTION ++ PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| PCL::|__si::MAKE-N-N| ++ PCL::USE-PACKAGE-PCL PCL::|__si::MAKE-CHECKING| ++ PCL::|STRUCTURE-OBJECT class constructor| ++ PCL::|__si::MAKE-CONSTANT-VALUE| ++ PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::|__si::MAKE-INITIAL| ++ PCL::|__si::MAKE-CACHE| PCL::|__si::MAKE-ONE-INDEX| ++ PCL::MAKE-PROGN PCL::TRUE PCL::MAKE-FAST-METHOD-CALL ++ PCL::|__si::MAKE-ARG-INFO| PCL::INTERN-PV-TABLE ++ PCL::|__si::MAKE-DFUN-INFO| PCL::|__si::MAKE-STD-INSTANCE| ++ PCL::|__si::MAKE-CACHING| PCL::|__si::MAKE-ONE-CLASS| ++ PCL::PV-WRAPPERS-FROM-PV-ARGS PCL::ZERO ++ PCL::|__si::MAKE-INITIAL-DISPATCH| ++ PCL::|__si::MAKE-NO-METHODS| PCL::STRING-APPEND ++ PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| PCL::MAKE-METHOD-CALL ++ PCL::FIX-EARLY-GENERIC-FUNCTIONS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ PCL::METHOD-PROTOTYPE-FOR-GF PCL::SPECIALIZER-FROM-TYPE ++ PCL::EMIT-ONE-INDEX-WRITERS PCL::*NORMALIZE-TYPE ++ PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::ANALYZE-LAMBDA-LIST ++ PCL::PARSE-DEFMETHOD PCL::GET-DISPATCH-FUNCTION ++ PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA ++ PCL::EMIT-CONSTANT-VALUE PCL::FIND-WRAPPER ++ PCL::MAKE-FINAL-DISPATCH-DFUN PCL::EARLY-COLLECT-INHERITANCE ++ PCL::GENERIC-FUNCTION-NAME-P PCL::EMIT-TWO-CLASS-READER ++ PCL::PARSE-METHOD-GROUP-SPECIFIER PCL::EMIT-ONE-CLASS-READER ++ PCL::FIND-STRUCTURE-CLASS PCL::EMIT-TWO-CLASS-WRITER ++ PCL::CONVERT-TO-SYSTEM-TYPE PCL::TYPE-FROM-SPECIALIZER ++ PCL::EMIT-ONE-CLASS-WRITER PCL::EARLY-METHOD-FUNCTION ++ PCL::MAKE-DISPATCH-DFUN PCL::NET-CODE-CONVERTER ++ PCL::GET-GENERIC-FUNCTION-INFO PCL::DEFAULT-CODE-CONVERTER ++ PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-ONE-INDEX-READERS ++ PCL::STRUCTURE-WRAPPER PCL::CLASS-EQ-TYPE ++ PCL::EMIT-IN-CHECKING-CACHE-P PCL::PCL-DESCRIBE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- PCL::%CCLOSURE-ENV-NTHCDR)) ++ ITERATE::RENAME-AND-CAPTURE-VARIABLES ++ PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ WALKER::WALK-PROG PCL::INVALIDATE-WRAPPER ++ PCL::COMPUTE-PRECEDENCE ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ WALKER::WALK-LAMBDA PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD ++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++ WALKER::WALK-MULTIPLE-VALUE-BIND ++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++ PCL::NOTE-PV-TABLE-REFERENCE ++ PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++ WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::CONVERT-TABLE ++ WALKER::WALK-LET ++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ PCL::SKIP-FAST-SLOT-ACCESS-P ++ PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++ PCL::OPTIMIZE-SLOT-BOUNDP PCL::TRACE-EMF-CALL-INTERNAL ++ ITERATE::SIMPLE-EXPAND-GATHERING-FORM ++ PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ WALKER::WALK-FLET PCL::ONE-CLASS-DFUN-INFO ++ WALKER::WALK-COMPILER-LET ++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++ PCL::FIRST-FORM-TO-LISP WALKER::WALK-DO* ++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++ PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++ PCL::PRINT-STD-INSTANCE ++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ WALKER::WALK-MACROLET PCL::GET-FUNCTION-GENERATOR ++ PCL::INITIALIZE-INTERNAL-SLOT-GFS* ++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++ PCL::COMPUTE-EFFECTIVE-METHOD PCL::EXPAND-DEFGENERIC ++ PCL::OBSOLETE-INSTANCE-TRAP WALKER::WALK-TAGBODY-1 ++ PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL ++ PCL::GET-NEW-FUNCTION-GENERATOR PCL::SORT-METHODS ++ WALKER::WALK-DO PCL::MAKE-DFUN-CALL ++ PCL::OPTIMIZE-GF-CALL-INTERNAL ++ PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++ PCL::OPTIMIZE-SET-SLOT-VALUE ++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ PCL::ENTRY-IN-CACHE-P ++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++ WALKER::WALK-IF PCL::MAKE-METHOD-SPEC PCL::SET-FUNCTION-NAME-1 ++ WALKER::WALK-SETQ ++ PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++ PCL::DECLARE-STRUCTURE PCL::EMIT-BOUNDP-CHECK ++ WALKER::WALK-LOCALLY ++ PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++ PCL::CAN-OPTIMIZE-ACCESS PCL::|SETF PCL PLIST-VALUE| ++ WALKER::WALK-LABELS PCL::EMIT-1-T-DLAP ++ PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ PCL::SORT-APPLICABLE-METHODS ++ PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ WALKER::WALK-NAMED-LAMBDA ITERATE::OPTIMIZE-ITERATE-FORM ++ PCL::MAP-ALL-ORDERS ++ PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++ ITERATE::OPTIMIZE-GATHERING-FORM ++ PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++ PCL::ONE-INDEX-DFUN-INFO ++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| ++ PCL::FLUSH-CACHE-TRAP WALKER::WALK-PROG* ++ ITERATE::VARIABLE-SAME-P PCL::EMIT-SLOT-READ-FORM ++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++ PCL::EMIT-GREATER-THAN-1-DLAP ++ PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++ PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS WALKER::WALK-LET* ++ WALKER::WALK-SYMBOL-MACROLET WALKER::VARIABLE-DECLARATION ++ PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++ WALKER::RECONS ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| ++ PCL::OPTIMIZE-SLOT-VALUE WALKER::RELIST-INTERNAL ++ PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++ PCL::|SETF PCL METHOD-FUNCTION-GET| WALKER::WALK-TAGBODY ++ WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL ++ PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++ PCL::PRINT-CACHE PCL::MAKE-TOP-LEVEL-FORM ++ PCL::FIX-SLOT-ACCESSORS WALKER::WALK-UNEXPECTED-DECLARE ++ PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))|)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) +- PCL::GET-WRAPPER-CACHE-NUMBER)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::GET-DECLARATION ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE ++ PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION ++ PCL::GET-METHOD-FUNCTION-PV-CELL ++ PCL::NAMED-OBJECT-PRINT-FUNCTION ++ PCL::FIND-CLASS-PREDICATE-FROM-CELL ++ PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::RECORD-DEFINITION ++ PCL::PROBE-CACHE PCL::INITIALIZE-INFO PCL::EMIT-MISS ++ PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION ++ PCL::FIND-CLASS-FROM-CELL PCL::PRECOMPUTE-EFFECTIVE-METHODS ++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 ++ PCL::METHOD-FUNCTION-GET PCL::MAP-CACHE ++ WALKER::CONVERT-MACRO-TO-LAMBDA PCL::MAKE-EMF-FROM-METHOD ++ PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS ++ PCL::REAL-ENSURE-GF-USING-CLASS--NULL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- PCL::NON-NEGATIVE-FIXNUM) +- PCL::CACHE-NLINES PCL::CACHE-MASK PCL::CACHE-SIZE +- PCL::CACHE-MAX-LOCATION)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL ++ PCL::BOOTSTRAP-SET-SLOT ++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (T T))| ++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ WALKER::WALK-TEMPLATE ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++ PCL::OPTIMIZE-WRITER ++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++ PCL::|(FAST-METHOD DOCUMENTATION (T))| ++ PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 ++ PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ PCL::LOAD-PRECOMPILED-IIS-ENTRY PCL::ADJUST-CACHE ++ WALKER::WALK-PROG/PROG* ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++ PCL::OPTIMIZE-READER ++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++ WALKER::WALK-BINDINGS-2 PCL::MEMF-TEST-CONVERTER ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++ PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR ++ PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++ PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ PCL::MAKE-DISPATCH-LAMBDA ++ PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ WALKER::WALK-DO/DO* PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE ++ PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++ PCL::GET-WRAPPERS-FROM-CLASSES ++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::EXPAND-CACHE ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| ++ PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++ PCL::EXPAND-SYMBOL-MACROLET-INTERNAL ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++ PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))| ++ WALKER::WALK-LET/LET* ++ PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| ++ PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ PCL::EXPAND-DEFCLASS PCL::INITIALIZE-INSTANCE-SIMPLE ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| ++ PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| ++ PCL::MAYBE-EXPAND-ACCESSOR-FORM ++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++ PCL::FILL-CACHE-P ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY ++ PCL::TWO-CLASS-DFUN-INFO)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- COMMON-LISP::SIMPLE-VECTOR) +- PCL::CACHE-VECTOR)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::EXPAND-EMF-CALL-METHOD ++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS ++ PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++ PCL::MAKE-INSTANCE-FUNCTION-COMPLEX ++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++ PCL::UPDATE-SLOTS-IN-PV ++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| ++ PCL::MAKE-PARAMETER-REFERENCES ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 ++ PCL::OPTIMIZE-INSTANCE-ACCESS PCL::OPTIMIZE-ACCESSOR-CALL ++ PCL::OPTIMIZE-GENERIC-FUNCTION-CALL ++ PCL::REAL-MAKE-METHOD-INITARGS-FORM ++ PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| ++ PCL::COMPUTE-PV-SLOT PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 ++ PCL::LOAD-FUNCTION-GENERATOR ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL ++ PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++ PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++ WALKER::WALK-BINDINGS-1 PCL::MAKE-INSTANCE-FUNCTION-SIMPLE ++ PCL::MAKE-FGEN WALKER::WALK-TEMPLATE-HANDLE-REPEAT ++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::MAKE-EMF-CACHE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::BOOTSTRAP-INITIALIZE-CLASS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::REAL-LOAD-DEFCLASS PCL::LOAD-DEFCLASS ++ PCL::OPTIMIZE-GF-CALL PCL::MAKE-EARLY-CLASS-DEFINITION ++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 PCL::EMIT-SLOT-ACCESS ++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION ++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::SET-ARG-INFO1)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::FILL-CACHE PCL::REAL-GET-METHOD PCL::MAKE-EMF-CALL ++ PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-1 ++ PCL::CAN-OPTIMIZE-ACCESS1 PCL::CHECK-INITARGS-2-PLIST ++ PCL::CHECK-INITARGS-2-LIST WALKER::WALK-ARGLIST ++ PCL::GET-METHOD)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::GET-SECONDARY-DISPATCH-FUNCTION1 PCL::EMIT-DLAP)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::FILL-DFUN-CACHE PCL::EARLY-ADD-NAMED-METHOD ++ PCL::REAL-ADD-NAMED-METHOD)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) +- PCL::ACCESSOR-VALUES-INTERNAL ++ PCL::ACCESSOR-VALUES1 PCL::CHECK-METHOD-ARG-INFO ++ PCL::EMIT-READER/WRITER PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++ PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION ++ PCL::CACHE-MISS-VALUES ++ PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::MAKE-FINAL-CACHING-DFUN + PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION ++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++ PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN ++ PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| + PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +- PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN +- PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +- PCL::CHECK-METHOD-ARG-INFO +- PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +- PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION +- PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++ PCL::ACCESSOR-VALUES-INTERNAL ITERATE::EXPAND-INTO-LET + PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION +- PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P +- ITERATE::WALK-GATHERING-BODY ++ PCL::CONSTANT-VALUE-MISS ++ PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION ++ WALKER::WALK-LET-IF ITERATE::WALK-GATHERING-BODY + PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER +- PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +- PCL::SLOT-BOUNDP-USING-CLASS-DFUN WALKER::WALK-FORM-INTERNAL +- PCL::LOAD-LONG-DEFCOMBIN PCL::MAKE-FINAL-CACHING-DFUN +- PCL::EMIT-READER/WRITER +- PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION +- PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS +- PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +- PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES1 +- PCL::GENERATING-LISP PCL::GET-CLASS-SLOT-VALUE-1 +- PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN PCL::CACHE-MISS-VALUES +- WALKER::WALK-LET-IF + PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| +- PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +- PCL::CHECKING-MISS ITERATE::EXPAND-INTO-LET ++ PCL::CHECKING-MISS PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN ++ PCL::GENERATING-LISP ITERATE::RENAME-VARIABLES ++ PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ PCL::CONVERT-METHODS PCL::SLOT-VALUE-USING-CLASS-DFUN ++ PCL::EMIT-READER/WRITER-FUNCTION ++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ PCL::CACHING-MISS + PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION +- PCL::CONSTANT-VALUE-MISS ITERATE::RENAME-VARIABLES +- PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ PCL::GET-CLASS-SLOT-VALUE-1 WALKER::WALK-FORM-INTERNAL ++ PCL::SLOT-BOUNDP-USING-CLASS-DFUN PCL::LOAD-LONG-DEFCOMBIN ++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| + PCL::SET-SLOT-VALUE +- PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| + PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| +- PCL::CONVERT-METHODS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +- PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +- PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +- PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +- PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN +- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| +- PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +- PCL::ADD-METHOD-DECLARATIONS +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +- PCL::WALK-METHOD-LAMBDA +- PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|)) ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))|)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) +- PCL::GET-ACCESSOR-METHOD-FUNCTION +- PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ PCL::ORDER-SPECIALIZERS ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ PCL::EMIT-CHECKING-OR-CACHING ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++ PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| + PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ PCL::GENERATE-DISCRIMINATION-NET ++ PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| + PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +- PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::GET-ACCESSOR-METHOD-FUNCTION + PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +- PCL::GENERATE-DISCRIMINATION-NET + PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +- PCL::LOAD-SHORT-DEFCOMBIN +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +- PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +- PCL::REAL-MAKE-METHOD-LAMBDA PCL::SET-CLASS-SLOT-VALUE-1 +- PCL::BOOTSTRAP-ACCESSOR-DEFINITION + PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +- PCL::ACCESSOR-MISS PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| +- PCL::ACCESSOR-VALUES ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION PCL::ACCESSOR-MISS ++ PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ PCL::LOAD-SHORT-DEFCOMBIN PCL::MAKE-FINAL-CHECKING-DFUN ++ PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++ PCL::MAKE-SHARED-INITIALIZE-FORM-LIST + PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| +- PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +- PCL::EMIT-CHECKING-OR-CACHING-FUNCTION + PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION +- PCL::MAKE-FINAL-CHECKING-DFUN +- PCL::MAKE-SHARED-INITIALIZE-FORM-LIST +- PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +- PCL::EMIT-CHECKING-OR-CACHING +- PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| +- PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +- PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| + PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| +- PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN ++ PCL::ACCESSOR-VALUES PCL::REAL-MAKE-METHOD-LAMBDA ++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITION ++ PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++ PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN + PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION + PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| +- PCL::ORDER-SPECIALIZERS +- PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +- PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|)) ++ PCL::SET-CLASS-SLOT-VALUE-1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) +- PCL::MAKE-N-N-ACCESSOR-DFUN +- PCL::GET-SIMPLE-INITIALIZATION-FUNCTION +- PCL::MAKE-FINAL-ACCESSOR-DFUN +- PCL::GET-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-ACCESSOR-TABLE +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-CHECKING-DFUN +- PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS +- PCL::MAKE-DEFAULT-INITARGS-FORM-LIST PCL::REAL-ADD-METHOD +- PCL::SLOT-VALUE-OR-DEFAULT PCL::LOAD-DEFGENERIC PCL::CPL-ERROR +- WALKER::NESTED-WALK-FORM PCL::TYPES-FROM-ARGUMENTS +- PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION)) ++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::WALK-METHOD-LAMBDA ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++ PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL ++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++ PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++ PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++ PCL::ADD-METHOD-DECLARATIONS ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) ++ PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW ++ PCL::PV-TABLE-SLOT-NAME-LISTS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) +- PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION +- PCL::GENERATE-DISCRIMINATION-NET-INTERNAL +- PCL::CACHE-MISS-VALUES-INTERNAL +- PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER)) ++ PCL::MAKE-DEFAULT-INITARGS-FORM-LIST ++ PCL::GET-EFFECTIVE-METHOD-FUNCTION PCL::LOAD-DEFGENERIC ++ PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS ++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION ++ PCL::SLOT-VALUE-OR-DEFAULT PCL::MAKE-CHECKING-DFUN ++ PCL::MAKE-FINAL-ACCESSOR-DFUN WALKER::NESTED-WALK-FORM ++ PCL::MAKE-ACCESSOR-TABLE PCL::REAL-ADD-METHOD ++ PCL::TYPES-FROM-ARGUMENTS ++ PCL::GET-SIMPLE-INITIALIZATION-FUNCTION PCL::CPL-ERROR ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION ++ PCL::MAKE-N-N-ACCESSOR-DFUN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::*) +- PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN WALKER::WALK-DECLARATIONS +- PCL::GET-SECONDARY-DISPATCH-FUNCTION)) ++ PCL::REAL-MAKE-A-METHOD)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) +- COMMON-LISP::*) +- PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| +- PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| +- ITERATE::ITERATE-TRANSFORM-BODY)) ++ COMMON-LISP::T) ++ PCL::LOAD-DEFMETHOD-INTERNAL PCL::EXPAND-DEFMETHOD)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- ITERATE::RENAME-LET-BINDINGS +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1)) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::EARLY-MAKE-A-METHOD PCL::LOAD-DEFMETHOD ++ PCL::MAKE-DEFMETHOD-FORM PCL::MAKE-DEFMETHOD-FORM-INTERNAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) +- PCL::REAL-MAKE-A-METHOD)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1 +- PCL::TRACE-METHOD-INTERNAL PCL::FDEFINE-CAREFULLY)) ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1 ++ ITERATE::RENAME-LET-BINDINGS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- PCL::ANALYZE-LAMBDA-LIST PCL::GET-DISPATCH-FUNCTION +- PCL::PARSE-DEFMETHOD PCL::MAKE-DISPATCH-DFUN +- PCL::EMIT-IN-CHECKING-CACHE-P PCL::EMIT-ONE-INDEX-READERS +- PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-ONE-CLASS-READER +- PCL::GENERIC-FUNCTION-NAME-P PCL::DEFAULT-CODE-CONVERTER +- PCL::CLASS-EQ-TYPE PCL::CONVERT-TO-SYSTEM-TYPE +- PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE +- PCL::GET-GENERIC-FUNCTION-INFO PCL::EARLY-METHOD-FUNCTION +- PCL::FIND-STRUCTURE-CLASS PCL::PCL-DESCRIBE +- PCL::NET-CODE-CONVERTER PCL::PARSE-METHOD-GROUP-SPECIFIER +- PCL::TYPE-FROM-SPECIALIZER PCL::EMIT-TWO-CLASS-WRITER +- PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EMIT-ONE-CLASS-WRITER +- PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA +- PCL::SPECIALIZER-FROM-TYPE PCL::EARLY-COLLECT-INHERITANCE +- PCL::EMIT-TWO-CLASS-READER PCL::FIND-WRAPPER +- PCL::*NORMALIZE-TYPE PCL::EMIT-ONE-INDEX-WRITERS +- PCL::STRUCTURE-WRAPPER PCL::MAKE-FINAL-DISPATCH-DFUN)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::DO-SHORT-METHOD-COMBINATION ++ PCL::GENERATE-DISCRIMINATION-NET-INTERNAL ++ PCL::CACHE-MISS-VALUES-INTERNAL ++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::MEMF-CODE-CONVERTER ++ PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- PCL::|__si::MAKE-INITIAL| PCL::|__si::MAKE-ARG-INFO| +- PCL::STRING-APPEND PCL::|__si::MAKE-ONE-INDEX| +- PCL::MAKE-INITIALIZE-INFO PCL::MAKE-FAST-METHOD-CALL +- PCL::|__si::MAKE-STD-INSTANCE| +- PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| +- PCL::|__si::MAKE-CONSTANT-VALUE| PCL::|__si::MAKE-N-N| +- PCL::FIX-EARLY-GENERIC-FUNCTIONS PCL::INTERN-PV-TABLE +- PCL::FALSE PCL::|__si::MAKE-DFUN-INFO| +- PCL::|__si::MAKE-CACHING| PCL::MAKE-PV-TABLE +- PCL::MAKE-METHOD-CALL PCL::TRUE PCL::MAKE-PROGN +- PCL::|__si::MAKE-CACHE| +- PCL::|STRUCTURE-OBJECT class constructor| +- PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| +- PCL::|__si::MAKE-NO-METHODS| PCL::|__si::MAKE-ONE-CLASS| +- PCL::|__si::MAKE-PV-TABLE| PCL::PV-WRAPPERS-FROM-PV-ARGS +- WALKER::UNBOUND-LEXICAL-FUNCTION PCL::|__si::MAKE-TWO-CLASS| +- PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| +- PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| +- PCL::MAKE-FAST-INSTANCE-BOUNDP +- PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL +- PCL::|__si::MAKE-CHECKING| PCL::|__si::MAKE-INITIAL-DISPATCH| +- PCL::|__si::MAKE-DISPATCH|)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ WALKER::WALK-DECLARATIONS PCL::GET-SECONDARY-DISPATCH-FUNCTION ++ PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) +- PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION +- PCL::CACHE-LIMIT-FN)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::GET-SECONDARY-DISPATCH-FUNCTION2)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN) +- PCL::CACHE-VALUEP)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ ITERATE::ITERATE-TRANSFORM-BODY ++ PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| ++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::INTEGER 1 255)) +- PCL::CACHE-NKEYS)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ PCL::COMPUTE-STD-CPL-PHASE-3)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::INTEGER 1 256)) +- PCL::CACHE-LINE-SIZE)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::FIXNUM) ++ COMMON-LISP::T) ++ PCL::FILL-CACHE-FROM-CACHE-P PCL::GET-CACHE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +- PCL::SYMBOL-APPEND)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) ++ PCL::GET-WRAPPER-CACHE-NUMBER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- (COMMON-LISP::*)) +- PCL::SORT-APPLICABLE-METHODS PCL::SORT-METHODS)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) ++ PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION ++ PCL::CACHE-LIMIT-FN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- PCL::COMPUTE-CALLS PCL::SET-STRUCTURE-SVUC-METHOD +- PCL::UPDATE-STD-OR-STR-METHODS PCL::SET-METHODS +- WALKER::NOTE-LEXICAL-BINDING ++ PCL::MEC-ALL-CLASS-LISTS PCL::REMOVE-SLOT-ACCESSORS ++ PCL::PARSE-GSPEC PCL::STANDARD-INSTANCE-ACCESS ++ PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER ++ PCL::UPDATE-STD-OR-STR-METHODS PCL::CLASS-MIGHT-PRECEDE-P ++ PCL::ACCESSOR-SET-SLOT-VALUE PCL::DOPLIST ++ PCL::ADD-SLOT-ACCESSORS PCL::DFUN-MISS ++ PCL::FSC-INSTANCE-WRAPPER PCL::CLASS-EQ-TEST ++ PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION ++ PCL::MAKE-EARLY-ACCESSOR WALKER::ENVIRONMENT-MACRO ++ PCL::WITH-DFUN-WRAPPERS PCL::WRAPPER-STATE ++ PCL::DFUN-INFO-WRAPPER0 ++ WALKER::WITH-NEW-DEFINITION-IN-ENVIRONMENT PCL::IF* ++ PCL::CHECK-WRAPPER-VALIDITY1 ++ PCL::INITIALIZE-INFO-MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER ++ PCL::FIND-CLASS-CELL-PREDICATE PCL::CLASS-CAN-PRECEDE-P ++ COMMON-LISP::CALL-METHOD PCL::NET-CONSTANT-CONVERTER ++ PCL::UPDATE-INITIALIZE-INFO-INTERNAL ++ PCL::GET-CACHE-VECTOR-LOCK-COUNT PCL::UNDEFMETHOD ++ PCL::%SET-SVREF PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS ++ PCL::WRAPPER-NO-OF-INSTANCE-SLOTS PCL::CACHE-VECTOR-LOCK-COUNT ++ WALKER::VARIABLE-LEXICAL-P PCL::FIN-LAMBDA-FN ++ PCL::INITIAL-CLASSES-AND-WRAPPERS PCL::MLOOKUP ++ PCL::RAISE-METATYPE ITERATE::WHILE PCL::EARLY-GF-ARG-INFO ++ PCL::INVALID-WRAPPER-P WALKER::VARIABLE-SPECIAL-P ++ PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRECOMPILED ++ PCL::INSTANCE-WRITE-INTERNAL WALKER::WALK-REPEAT-EVAL ++ WALKER::GET-WALKER-TEMPLATE-INTERNAL ITERATE::PLIST-ELEMENTS ++ PCL::MAKE-FIND-CLASS-CELL COMMON-LISP::WITH-ACCESSORS ++ PCL::MAKE-METHOD-FUNCTION PCL::SIMPLE-LEXICAL-METHOD-FUNCTIONS ++ PCL::CANONICALIZE-DEFCLASS-OPTION PCL::UPDATE-INITS PCL::SCASE ++ PCL::INSTANCE-BOUNDP-INTERNAL PCL::FMC-FUNCALL ++ PCL::SET-METHODS PCL::CACHE-LOCK-COUNT PCL::GET-WRAPPER ++ PCL::INVOKE-METHOD-CALL1 PCL::MAKE-CLASS-PREDICATE ++ PCL::PRINTING-RANDOM-THING PCL::UPDATE-SLOTS ++ PCL::FUNCTION-APPLY PCL::AUGMENT-TYPE ITERATE::WITH-GATHERING ++ PCL::CHECKING-DFUN-INFO PCL::LIST-EQ PCL::CACHE-VECTOR-SIZE ++ PCL::DESCRIBE-PACKAGE PCL::WRAPPER-REF PCL::PLIST-VALUE ++ PCL::%INSTANCE-REF WALKER::NOTE-DECLARATION ++ PCL::MAKE-STD-READER-METHOD-FUNCTION ++ PCL::EMIT-READER/WRITER-MACRO WALKER::ENVIRONMENT-FUNCTION ++ PCL::N-N-DFUN-INFO ++ PCL::FIND-CLASS-CELL-MAKE-INSTANCE-FUNCTION-KEYS ++ PCL::DEFCONSTRUCTOR PCL::INSTANCE-SLOT-INDEX ++ PCL::CLASS-NO-OF-INSTANCE-SLOTS ITERATE::ELEMENTS ++ PCL::NEXT-WRAPPER-CACHE-NUMBER-INDEX ++ PCL::INITIALIZE-INFO-COMBINED-INITARGS-FORM-LIST ++ COMMON-LISP::DEFINE-METHOD-COMBINATION PCL::MDOTIMES ++ PCL::REMOVE-DIRECT-SUBCLASSES PCL::MAKE-WRAPPER-INTERNAL ++ ITERATE::MAXIMIZING PCL::PV-OFFSET ++ PCL::DEAL-WITH-ARGUMENTS-OPTION PCL::INSTANCE-READER ++ PCL::ALLOCATE-STANDARD-INSTANCE--MACRO PCL::DEFINE-INLINES ++ PCL::WRAPPER-CACHE-NUMBER-VECTOR PCL::GATHERING1 ++ PCL::FIND-CLASS-CELL-CLASS PCL::SWAP-WRAPPERS-AND-SLOTS ++ PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION PCL::PV-TABLE-LOOKUP ++ PCL::WRAPPER-INSTANCE-SLOTS-LAYOUT ++ WALKER::WALKER-ENVIRONMENT-BIND PCL::COPY-SLOTS PCL::MCASE ++ PCL::ADD-TO-CVECTOR PCL::ADD-DIRECT-SUBCLASSES ++ PCL::%SET-CCLOSURE-ENV PCL::PRECOMPILE-RANDOM-CODE-SEGMENTS ++ PCL::UPDATE-CLASS PCL::SLOT-SYMBOL PCL::VALUE-FOR-CACHING ++ PCL::EXPANDING-MAKE-INSTANCE-TOP-LEVEL PCL::REMTAIL ++ PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST ++ PCL::CLASSES-HAVE-COMMON-SUBCLASS-P ++ PCL::FIRST-WRAPPER-CACHE-NUMBER-INDEX ++ PCL::INITIALIZE-INFO-INITARGS-FORM-LIST ++ PCL::WITH-MAKE-INSTANCE-FUNCTION-VALID-P-CHECK ++ PCL::FUNCALLABLE-INSTANCE-DATA-1 PCL::SAUT-NOT-EQL ++ PCL::EARLY-GF-METHODS ITERATE::EXTRACT-SPECIAL-BINDINGS ++ PCL::MEMQ PCL::DFUN-UPDATE ++ PCL::MAKE-CHECKING-OR-CACHING-FUNCTION-LIST PCL::ONCE-ONLY ++ PCL::GET-INSTANCE-WRAPPER-OR-NIL PCL::SYMBOL-LESSP ++ PCL::|SETF PCL FIND-CLASS| PCL::PARSE-QUALIFIER-PATTERN + ITERATE::SIMPLE-EXPAND-ITERATE-FORM +- PCL::|SETF PCL METHOD-FUNCTION-PLIST| PCL::SAUT-NOT-PROTOTYPE +- PCL::VALUE-FOR-CACHING PCL::PROCLAIM-DEFMETHOD +- PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST +- PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::METHODS-CONVERTER +- PCL::DEAL-WITH-ARGUMENTS-OPTION +- PCL::UPDATE-ALL-PV-TABLE-CACHES +- PCL::MAP-PV-TABLE-REFERENCES-OF PCL::UPDATE-CLASS +- PCL::FIND-STANDARD-II-METHOD +- PCL::METHOD-FUNCTION-RETURNING-NIL +- PCL::REDIRECT-EARLY-FUNCTION-INTERNAL PCL::UPDATE-CPL +- PCL::QUALIFIER-CHECK-RUNTIME PCL::COMPUTE-STD-CPL +- PCL::COMPUTE-CONSTANTS PCL::ADD-FORMS PCL::AUGMENT-TYPE +- PCL::MEMF-CONSTANT-CONVERTER PCL::SWAP-WRAPPERS-AND-SLOTS +- PCL::SET-WRAPPER PCL::GET-KEY-ARG PCL::MAKE-PLIST +- PCL::MAKE-PV-TABLE-INTERNAL ITERATE::EXTRACT-SPECIAL-BINDINGS +- PCL::SAUT-NOT-EQL WALKER::VARIABLE-SYMBOL-MACRO-P +- PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +- PCL::SET-FUNCTION-PRETTY-ARGLIST +- PCL::GF-MAKE-FUNCTION-FROM-EMF PCL::FIND-SLOT-DEFINITION +- PCL::SET-STANDARD-SVUC-METHOD PCL::ADD-TO-CVECTOR +- PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS COMMON-LISP::REMOVE-METHOD +- PCL::CHECKING-DFUN-INFO PCL::PARSE-QUALIFIER-PATTERN +- PCL::%SET-CCLOSURE-ENV PCL::MAKE-CDXR +- PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS +- PCL::NET-CONSTANT-CONVERTER PCL::|SETF PCL FIND-CLASS| ++ PCL::INITIALIZE-INFO-SHARED-INITIALIZE-T-FUNCTION ++ PCL::RESET-INITIALIZE-INFO-INTERNAL ++ PCL::INITIALIZE-INFO-DEFAULT-INITARGS-FUNCTION ++ PCL::DESTRUCTURE-INTERNAL PCL::DFUN-INFO-INDEX ++ PCL::PRECOMPILE-IIS-FUNCTIONS PCL::INSTANCE-WRITE ++ COMMON-LISP::DEFCLASS PCL::UPDATE-ALL-PV-TABLE-CACHES ++ PCL::WRAPPER-CACHE-NUMBER-VECTOR-REF ++ PCL::INITIALIZE-INFO-COMBINED-INITIALIZE-FUNCTION ++ PCL::MODIFY-CACHE PCL::BOOTSTRAP-SLOT-INDEX ++ PCL::SET-FUNCTION-PRETTY-ARGLIST PCL::COMPUTE-LAYOUT ++ PCL::CALL-METHOD-LIST PCL::GET-KEY-ARG ITERATE::LIST-TAILS ++ PCL::INITIALIZE-INFO-MAKE-INSTANCE-FUNCTION ITERATE::EACHTIME ++ PCL::INSTANCE-REF PCL::WITH-EQ-HASH-TABLE ++ PCL::QUALIFIER-CHECK-RUNTIME PCL::CALLSREF ITERATE::MV-SETQ ++ PCL::PRINTING-RANDOM-THING-INTERNAL PCL::CHECK-MEMBER ++ PCL::INSTANCE-WRITER PCL::CANONICALIZE-SLOT-SPECIFICATION ++ PCL::BIND-LEXICAL-METHOD-FUNCTIONS ITERATE::LIST-ELEMENTS ++ PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION-FAST ++ PCL::INVOKE-METHOD-CALL PCL::INITIALIZE-INFO-RI-VALID-P ++ PCL::SET-WRAPPER PCL::STD-INSTANCE-CLASS ++ PCL::EXPANDING-MAKE-INSTANCE PCL::BIND-ARGS ++ PCL::INITIALIZE-INFO-VALID-P PCL::STD-INSTANCE-WRAPPER ++ PCL::FSC-INSTANCE-SLOTS PCL::REAL-ENSURE-GF-INTERNAL PCL::NEQ ++ PCL::PRECOMPILE-DFUN-CONSTRUCTORS PCL::MAKE-DLAP-LAMBDA-LIST ++ PCL::FIND-SLOT-DEFINITION ++ PCL::BIND-SIMPLE-LEXICAL-METHOD-MACROS ++ PCL::ACCESSOR-SLOT-VALUE PCL::METHOD-FUNCTION-RETURNING-NIL ++ PCL::MAKE-DFUN-LAMBDA-LIST WALKER::VARIABLE-SYMBOL-MACRO-P ++ PCL::DFUN-INFO-FUNCTION COMMON-LISP::WITH-SLOTS ++ PCL::FUNCTION-FUNCALL PCL::EQL-TEST ++ PCL::INITIALIZE-INFO-CONSTANTS PCL::POSQ PCL::DOLIST-CAREFULLY ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-MACRO PCL::MAKE-CAXR ++ ITERATE::ITERATE PCL::DEFINE-INITIALIZE-INFO PCL::ALIST-ENTRY ++ PCL::WITH-LOCAL-CACHE-FUNCTIONS PCL::WRAPPER-OF-MACRO ++ PCL::RASSQ PCL::SUPERCLASSES-COMPATIBLE-P + PCL::METHOD-FUNCTION-RETURNING-T PCL::CHANGE-CLASS-INTERNAL +- PCL::MAKE-DFUN-ARG-LIST PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER +- PCL::MAKE-STD-WRITER-METHOD-FUNCTION ITERATE::MV-SETQ +- PCL::MAKE-EARLY-ACCESSOR PCL::GET-KEY-ARG1 +- PCL::ADD-DIRECT-SUBCLASSES PCL::DO-SATISFIES-DEFTYPE +- PCL::N-N-DFUN-INFO PCL::CLASSES-HAVE-COMMON-SUBCLASS-P +- PCL::SAUT-NOT-CLASS PCL::CANONICALIZE-DEFCLASS-OPTION +- PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST +- WALKER::VARIABLE-LEXICAL-P WALKER::ENVIRONMENT-FUNCTION +- PCL::PV-TABLE-LOOKUP PCL::DESTRUCTURE-INTERNAL +- PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION +- PCL::REMOVE-SLOT-ACCESSORS ++ PCL::PRECOMPILE-FUNCTION-GENERATORS ++ WALKER::DEFINE-WALKER-TEMPLATE PCL::CACHE-VECTOR-REF ++ PCL::GET-SLOTS PCL::MEC-ALL-CLASSES-INTERNAL ++ COMMON-LISP::SLOT-EXISTS-P PCL::WITHOUT-INTERRUPTS ++ PCL::MAKE-UNORDERED-METHODS-EMF PCL::GET-KEY-ARG1 ++ PCL::MAKE-STD-WRITER-METHOD-FUNCTION PCL::COMPUTE-CONSTANTS ++ PCL::BOOTSTRAP-GET-SLOT PCL::DEFINE-GF-PREDICATE ++ PCL::REDIRECT-EARLY-FUNCTION-INTERNAL ++ PCL::SET-STRUCTURE-SVUC-METHOD PCL::WRAPPER-CLASS ++ ITERATE::UNTIL PCL::PV-BINDING1 PCL::UPDATE-CPL PCL::PV-ENV ++ PCL::PV-BINDING PCL::INSTANCE-READ-INTERNAL ++ COMMON-LISP::DEFGENERIC ITERATE::COLLECTING ++ WALKER::NOTE-LEXICAL-BINDING PCL::ORIGINAL-DEFINITION ++ PCL::COLLECTING-ONCE PCL::GET-SLOTS-OR-NIL PCL::TRACE-EMF-CALL ++ PCL::WITH-HASH-TABLE PCL::FUNCALLABLE-INSTANCE-MARKER ++ PCL::INITIALIZE-INFO-NEW-KEYS PCL::STD-INSTANCE-SLOTS ++ PCL::ACCESSOR-SLOT-BOUNDP PCL::SAUT-NOT-PROTOTYPE ++ PCL::MAP-PV-TABLE-REFERENCES-OF COMMON-LISP::ADD-METHOD ++ PCL::MAKE-CDXR PCL::CALL-INITIALIZE-FUNCTION PCL::ASV-FUNCALL ++ PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::IIS-BODY ++ COMMON-LISP::DEFMETHOD PCL::SYMBOL-OR-CONS-LESSP ++ PCL::SAUT-NOT-CLASS-EQ PCL::METHODS-CONVERTER PCL::PVREF ++ PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++ PCL::EMIT-CHECKING-OR-CACHING-MACRO ITERATE::SUMMING ++ PCL::|SETF PCL GDEFINITION| PCL::ESETF PCL::COPY-PV ++ PCL::WRAPPER-CLASS* COMMON-LISP::REMOVE-METHOD + PCL::|SETF PCL FIND-CLASS-PREDICATE| +- PCL::|SETF PCL GDEFINITION| PCL::MAKE-DFUN-LAMBDA-LIST +- PCL::CANONICALIZE-SLOT-SPECIFICATION WALKER::WALK-REPEAT-EVAL +- PCL::STANDARD-INSTANCE-ACCESS +- PCL::PRINTING-RANDOM-THING-INTERNAL PCL::REMTAIL +- PCL::ACCESSOR-MISS-FUNCTION PCL::COMPUTE-LAYOUT +- PCL::CLASS-MIGHT-PRECEDE-P +- PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +- SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::PLIST-VALUE +- PCL::MAKE-CAXR PCL::MAKE-DLAP-LAMBDA-LIST +- PCL::MAKE-STD-READER-METHOD-FUNCTION WALKER::ENVIRONMENT-MACRO +- PCL::UPDATE-SLOTS PCL::VARIABLE-CLASS +- PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION PCL::LIST-EQ +- PCL::ADD-SLOT-ACCESSORS PCL::SAUT-NOT-CLASS-EQ PCL::COMPUTE-PV +- PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::UPDATE-INITS +- PCL::MEC-ALL-CLASS-LISTS PCL::RAISE-METATYPE +- WALKER::NOTE-DECLARATION PCL::EMIT-1-NIL-DLAP +- PCL::BOOTSTRAP-SLOT-INDEX PCL::SUPERCLASSES-COMPATIBLE-P +- PCL::MEC-ALL-CLASSES-INTERNAL COMMON-LISP::SLOT-EXISTS-P +- PCL::DESCRIBE-PACKAGE PCL::NO-SLOT PCL::PROCLAIM-DEFGENERIC +- COMMON-LISP::ADD-METHOD PCL::MAKE-UNORDERED-METHODS-EMF +- PCL::MEC-ALL-CLASSES PCL::SYMBOL-OR-CONS-LESSP +- PCL::UPDATE-INITIALIZE-INFO-INTERNAL PCL::CLASS-CAN-PRECEDE-P +- PCL::SYMBOL-LESSP PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION +- PCL::MAKE-CLASS-PREDICATE WALKER::VARIABLE-SPECIAL-P +- PCL::REMOVE-DIRECT-SUBCLASSES)) ++ PCL::ACCESSOR-MISS-FUNCTION PCL::MEMF-CONSTANT-CONVERTER ++ PCL::DELQ PCL::VECTORIZING PCL::MAKE-DFUN-ARG-LIST ++ PCL::VARIABLE-CLASS PCL::INSTANCE-ACCESSOR-PARAMETER ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-SLOTS ++ PCL::EMIT-DEFAULT-ONLY-MACRO PCL::NO-SLOT ++ PCL::MAYBE-CHECK-CACHE PCL::FUNCALLABLE-INSTANCE-DATA-POSITION ++ PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST ++ PCL::DO-STANDARD-DEFSETF PCL::SAUT-NOT-CLASS ++ PCL::DFUN-INFO-ACCESSOR-TYPE PCL::DEFINE-CACHED-READER ++ PCL::SET-STANDARD-SVUC-METHOD PCL::CLASS-TEST ++ PCL::MAKE-PV-TABLE-INTERNAL PCL::PROCLAIM-DEFGENERIC ++ PCL::GF-MAKE-FUNCTION-FROM-EMF PCL::COMPUTE-PV ++ PCL::EMIT-1-NIL-DLAP PCL::FIND-STANDARD-II-METHOD ++ PCL::BIND-FAST-LEXICAL-METHOD-MACROS PCL::DO-SATISFIES-DEFTYPE ++ PCL::FAST-LEXICAL-METHOD-FUNCTIONS PCL::COMPUTE-CALLS ++ PCL::COPY-INSTANCE-INTERNAL COMMON-LISP::SYMBOL-MACROLET ++ PCL::FSC-INSTANCE-P PCL::MAKE-PLIST PCL::%SVREF ++ PCL::PCL-DESTRUCTURING-BIND ++ SYSTEM::%SET-COMPILED-FUNCTION-NAME ITERATE::JOINING ++ ITERATE::MINIMIZING PCL::METHOD-FUNCTION-CLOSURE-GENERATOR ++ PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::*LIST-ELEMENTS ++ PCL::ADD-FORMS ++ PCL::INITIALIZE-INFO-SHARED-INITIALIZE-NIL-FUNCTION ++ ITERATE::INTERVAL PCL::INSTANCE-BOUNDP PCL::FSC-INSTANCE-CLASS ++ WALKER::WITH-AUGMENTED-ENVIRONMENT ++ PCL::CACHE-NUMBER-VECTOR-REF ++ PCL::INVOKE-EFFECTIVE-METHOD-FUNCTION PCL::ASSQ ++ PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION ++ PCL::WRAPPER-CLASS-SLOTS PCL::MEC-ALL-CLASSES ++ ITERATE::GATHERING PCL::INSTANCE-READ PCL::COMPUTE-STD-CPL ++ PCL::PROCLAIM-DEFMETHOD ++ PCL::%ALLOCATE-STATIC-SLOT-STORAGE--CLASS PCL::*LIST-TAILS ++ PCL::|SETF PCL METHOD-FUNCTION-PLIST| ++ PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS ++ PCL::DFUN-INFO-WRAPPER1 PCL::INVOKE-FAST-METHOD-CALL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) ++ PCL::COMPILE-LAMBDA PCL::COERCE-TO-CLASS + PCL::MAKE-METHOD-FUNCTION-INTERNAL +- PCL::MAKE-FINAL-DFUN-INTERNAL WALKER::MACROEXPAND-ALL +- COMMON-LISP::ENSURE-GENERIC-FUNCTION +- PCL::MAKE-METHOD-LAMBDA-INTERNAL PCL::MAKE-CONSTANT-VALUE-DFUN +- PCL::GET-FUNCTION PCL::EXTRACT-DECLARATIONS +- PCL::COERCE-TO-CLASS PCL::PARSE-METHOD-OR-SPEC +- PCL::DISPATCH-DFUN-COST PCL::PARSE-SPECIALIZED-LAMBDA-LIST +- PCL::MAP-ALL-CLASSES PCL::COMPILE-LAMBDA PCL::ENSURE-CLASS +- PCL::GET-METHOD-FUNCTION WALKER::WALK-FORM +- PCL::ALLOCATE-STRUCTURE-INSTANCE PCL::GET-FUNCTION1 ++ PCL::MAKE-CONSTANT-VALUE-DFUN PCL::GET-FUNCTION + PCL::MAKE-CACHING-DFUN PCL::MAKE-INSTANCE-1 +- PCL::GET-DFUN-CONSTRUCTOR)) ++ PCL::MAKE-FINAL-DFUN-INTERNAL WALKER::MACROEXPAND-ALL ++ COMMON-LISP::ENSURE-GENERIC-FUNCTION PCL::MAP-ALL-CLASSES ++ PCL::GET-METHOD-FUNCTION PCL::MAKE-METHOD-LAMBDA-INTERNAL ++ PCL::PARSE-SPECIALIZED-LAMBDA-LIST PCL::GET-FUNCTION1 ++ WALKER::WALK-FORM PCL::ALLOCATE-STRUCTURE-INSTANCE ++ PCL::ENSURE-CLASS PCL::GET-DFUN-CONSTRUCTOR ++ PCL::EXTRACT-DECLARATIONS PCL::DISPATCH-DFUN-COST ++ PCL::PARSE-METHOD-OR-SPEC)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +- PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::SDFUN-FOR-CACHING PCL::SAUT-AND PCL::EMIT-CHECKING ++ PCL::SPLIT-DECLARATIONS ++ PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES PCL::COMPUTE-CODE ++ PCL::*SUBTYPEP ITERATE::PARSE-DECLARATIONS ++ PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P ++ PCL::SLOT-NAME-LISTS-FROM-SLOTS COMMON-LISP::SLOT-VALUE ++ PCL::COMPUTE-STD-CPL-PHASE-1 PCL::SAUT-CLASS ++ PCL::FORM-LIST-TO-LISP PCL::INITIAL-DFUN ++ PCL::FIND-SUPERCLASS-CHAIN PCL::EMIT-CACHING PCL::SAUT-NOT ++ PCL::CHECK-INITARGS-VALUES PCL::REAL-REMOVE-METHOD ++ PCL::CPL-INCONSISTENT-ERROR COMMON-LISP::SLOT-BOUNDP ++ PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P ++ PCL::MAKE-INSTANCE-FUNCTION-TRAP PCL::SAUT-CLASS-EQ ++ PCL::SLOT-UNBOUND-INTERNAL PCL::SAUT-PROTOTYPE ++ PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR ++ PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL ++ PCL::EMIT-DEFAULT-ONLY PCL::CLASS-APPLICABLE-USING-CLASS-P ++ PCL::COMPUTE-TEST PCL::MUTATE-SLOTS-AND-CALLS ++ PCL::EMIT-DEFAULT-ONLY-FUNCTION PCL::ENSURE-CLASS-VALUES ++ PCL::INVOKE-EMF COMMON-LISP::SLOT-MAKUNBOUND ++ PCL::MAKE-DIRECT-SLOTD PCL::INSURE-DFUN PCL::SET-FUNCTION-NAME ++ PCL::DESTRUCTURE PCL::SAUT-EQL PCL::UPDATE-SLOT-VALUE-GF-INFO)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- (COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*)) +- PCL::CAPITALIZE-WORDS)) ++ COMMON-LISP::T) ++ WALKER::RELIST* PCL::UPDATE-DFUN ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE PCL::MAKE-SPECIALIZABLE ++ PCL::TRACE-METHOD PCL::ALLOCATE-STANDARD-INSTANCE ++ WALKER::RELIST COMMON-LISP::FIND-CLASS PCL::MAKE-WRAPPER ++ PCL::PV-TABLE-LOOKUP-PV-ARGS ITERATE::FUNCTION-LAMBDA-P ++ PCL::SET-DFUN PCL::EARLY-METHOD-SPECIALIZERS ++ WALKER::WALKER-ENVIRONMENT-BIND-1 ++ PCL::INITIALIZE-METHOD-FUNCTION PCL::MAKE-TYPE-PREDICATE-NAME ++ PCL::MAKE-FINAL-DFUN PCL::FIND-CLASS-CELL ++ PCL::INITIALIZE-INTERNAL-SLOT-GFS PCL::MAKE-EARLY-GF ++ PCL::USE-DISPATCH-DFUN-P ITERATE::MAYBE-WARN ++ PCL::USE-CONSTANT-VALUE-DFUN-P PCL::FIND-CLASS-PREDICATE ++ PCL::SET-ARG-INFO PCL::CAPITALIZE-WORDS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 PCL::SHOW-EMF-CALL-TRACE +- PCL::CACHES-TO-ALLOCATE PCL::MAKE-CACHE +- PCL::SHOW-FREE-CACHE-VECTORS PCL::MAKE-ARG-INFO +- PCL::NO-METHODS-DFUN-INFO PCL::STRUCTURE-FUNCTIONS-EXIST-P +- PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST +- PCL::BOOTSTRAP-BUILT-IN-CLASSES +- PCL::%%ALLOCATE-INSTANCE--CLASS PCL::DISPATCH-DFUN-INFO +- PCL::INITIAL-DISPATCH-DFUN-INFO PCL::BOOTSTRAP-META-BRAID +- PCL::UPDATE-DISPATCH-DFUNS PCL::LIST-ALL-DFUNS +- PCL::DEFAULT-METHOD-ONLY-DFUN-INFO PCL::RENEW-SYS-FILES +- PCL::IN-THE-COMPILER-P PCL::GET-EFFECTIVE-METHOD-GENSYM +- PCL::MAKE-CPD PCL::INITIAL-DFUN-INFO +- PCL::SHOW-DFUN-CONSTRUCTORS +- PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::PRINT-DFUN-INFO)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::FIXNUM) +- PCL::ZERO)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ COMMON-LISP::SIMPLE-VECTOR) ++ PCL::CACHE-VECTOR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::PRINT-DFUN-INFO)) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++ PCL::SYMBOL-APPEND)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL)) ++ PCL::PV-TABLE-CACHE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -412,70 +1019,11 @@ + PCL::COMPUTE-CACHE-PARAMETERS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +- PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-WRITERS +- PCL::EMIT-N-N-READERS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::MAKE-FINAL-DFUN PCL::SET-ARG-INFO PCL::TRACE-METHOD +- PCL::MAKE-SPECIALIZABLE WALKER::WALKER-ENVIRONMENT-BIND-1 +- ITERATE::FUNCTION-LAMBDA-P COMMON-LISP::FIND-CLASS +- PCL::MAKE-WRAPPER PCL::UPDATE-DFUN +- PCL::MAKE-TYPE-PREDICATE-NAME PCL::PV-TABLE-LOOKUP-PV-ARGS +- PCL::USE-CONSTANT-VALUE-DFUN-P WALKER::RELIST +- PCL::MAKE-EARLY-GF PCL::INITIALIZE-METHOD-FUNCTION +- PCL::FIND-CLASS-CELL PCL::USE-DISPATCH-DFUN-P +- PCL::FIND-CLASS-PREDICATE PCL::ALLOCATE-STANDARD-INSTANCE +- PCL::INITIALIZE-INTERNAL-SLOT-GFS ITERATE::MAYBE-WARN +- PCL::ALLOCATE-FUNCALLABLE-INSTANCE +- PCL::EARLY-METHOD-SPECIALIZERS WALKER::RELIST* PCL::SET-DFUN)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- PCL::SLOT-UNBOUND-INTERNAL ITERATE::PARSE-DECLARATIONS +- PCL::EMIT-CACHING PCL::COMPUTE-STD-CPL-PHASE-1 +- PCL::INITIAL-DFUN PCL::INSURE-DFUN PCL::EMIT-CHECKING +- PCL::COMPUTE-TEST PCL::COMPUTE-CODE PCL::MAKE-DIRECT-SLOTD +- PCL::SAUT-CLASS COMMON-LISP::SLOT-MAKUNBOUND +- PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::INVOKE-EMF +- PCL::*SUBTYPEP PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P +- PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES +- PCL::REAL-REMOVE-METHOD PCL::SAUT-PROTOTYPE +- PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN +- COMMON-LISP::SLOT-BOUNDP PCL::FORM-LIST-TO-LISP +- PCL::CPL-INCONSISTENT-ERROR PCL::EMIT-DEFAULT-ONLY-FUNCTION +- PCL::ENSURE-CLASS-VALUES PCL::CHECK-INITARGS-VALUES +- PCL::SAUT-EQL PCL::SPLIT-DECLARATIONS +- PCL::UPDATE-SLOT-VALUE-GF-INFO PCL::SAUT-AND +- PCL::SLOT-NAME-LISTS-FROM-SLOTS +- PCL::MAKE-INSTANCE-FUNCTION-TRAP PCL::EMIT-DEFAULT-ONLY +- PCL::SAUT-NOT PCL::SAUT-CLASS-EQ COMMON-LISP::SLOT-VALUE +- PCL::DESTRUCTURE PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P +- PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL +- PCL::CLASS-APPLICABLE-USING-CLASS-P PCL::SDFUN-FOR-CACHING +- PCL::SET-FUNCTION-NAME)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- PCL::ARG-INFO-NUMBER-REQUIRED PCL::CACHING-LIMIT-FN +- PCL::PV-CACHE-LIMIT-FN PCL::ONE-INDEX-LIMIT-FN +- PCL::PV-TABLE-PV-SIZE PCL::CACHE-COUNT PCL::DEFAULT-LIMIT-FN +- PCL::CPD-COUNT PCL::CHECKING-LIMIT-FN +- PCL::N-N-ACCESSORS-LIMIT-FN PCL::EARLY-CLASS-SIZE +- PCL::FAST-INSTANCE-BOUNDP-INDEX)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +- PCL::POWER-OF-TWO-CEILING)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) + COMMON-LISP::T) +- PCL::GET-CACHE-FROM-CACHE)) ++ PCL::GET-CACHE-FROM-CACHE ++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -484,544 +1032,81 @@ + PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) +- PCL::CACHE-FIELD)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL)) +- PCL::PV-TABLE-CACHE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +- WALKER::WALK-TEMPLATE PCL::|(FAST-METHOD PRINT-OBJECT (T T))| +- WALKER::WALK-DO/DO* PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR +- PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| +- WALKER::WALK-LET/LET* +- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +- PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE +- PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +- PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +- PCL::INITIALIZE-INSTANCE-SIMPLE +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +- PCL::EXPAND-SYMBOL-MACROLET-INTERNAL +- PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +- PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +- PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +- PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| +- PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +- PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +- PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +- PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +- PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +- PCL::MAKE-DISPATCH-LAMBDA +- PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- PCL::EXPAND-DEFCLASS +- PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +- PCL::OPTIMIZE-WRITER +- PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD DOCUMENTATION (T))| +- PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| +- PCL::OPTIMIZE-READER WALKER::WALK-PROG/PROG* +- PCL::BOOTSTRAP-SET-SLOT +- PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +- PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- PCL::TWO-CLASS-DFUN-INFO +- PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))| +- PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- PCL::ADJUST-CACHE +- PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +- PCL::EXPAND-CACHE +- PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +- PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| +- PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +- PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +- PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| +- PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +- PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +- PCL::GET-WRAPPERS-FROM-CLASSES +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +- PCL::MAYBE-EXPAND-ACCESSOR-FORM WALKER::WALK-BINDINGS-2 +- PCL::FILL-CACHE-P PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL +- PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +- PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| +- PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +- PCL::LOAD-PRECOMPILED-IIS-ENTRY PCL::MEMF-TEST-CONVERTER +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::REAL-ADD-NAMED-METHOD PCL::EARLY-ADD-NAMED-METHOD +- PCL::FILL-DFUN-CACHE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::OBSOLETE-INSTANCE-TRAP +- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| +- WALKER::WALK-TAGBODY +- PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- PCL::ENTRY-IN-CACHE-P WALKER::WALK-COMPILER-LET +- PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +- PCL::NOTE-PV-TABLE-REFERENCE PCL::COMPUTE-EFFECTIVE-METHOD +- PCL::MAKE-DFUN-CALL PCL::|SETF PCL PLIST-VALUE| +- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +- PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +- PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +- PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- WALKER::WALK-UNEXPECTED-DECLARE +- PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL +- PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1 +- WALKER::WALK-DO PCL::EMIT-1-T-DLAP PCL::PRINT-STD-INSTANCE +- PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +- WALKER::WALK-LAMBDA PCL::MAKE-METHOD-SPEC +- PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| +- PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +- PCL::OPTIMIZE-SET-SLOT-VALUE +- PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::EXPAND-DEFGENERIC WALKER::VARIABLE-DECLARATION +- ITERATE::RENAME-AND-CAPTURE-VARIABLES +- PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +- PCL::MAP-ALL-ORDERS +- PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +- PCL::DECLARE-STRUCTURE WALKER::WALK-PROG +- PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +- PCL::OPTIMIZE-SLOT-VALUE WALKER::WALK-MULTIPLE-VALUE-BIND +- PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +- PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD WALKER::WALK-LOCALLY +- PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +- WALKER::WALK-DO* +- PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| +- PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::EMIT-BOUNDP-CHECK WALKER::RECONS +- PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +- PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| +- WALKER::WALK-LET* WALKER::WALK-TAGBODY-1 PCL::FLUSH-CACHE-TRAP +- WALKER::WALK-FLET +- PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| +- PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| +- PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +- PCL::PRINT-CACHE +- PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +- PCL::INVALIDATE-WRAPPER PCL::GET-NEW-FUNCTION-GENERATOR +- ITERATE::OPTIMIZE-ITERATE-FORM WALKER::RELIST-INTERNAL +- PCL::CAN-OPTIMIZE-ACCESS PCL::MAKE-TOP-LEVEL-FORM +- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +- WALKER::WALK-MULTIPLE-VALUE-SETQ WALKER::WALK-LABELS +- PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +- PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +- PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +- WALKER::WALK-SETQ WALKER::WALK-LET +- PCL::|SETF PCL METHOD-FUNCTION-GET| WALKER::WALK-IF +- PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +- ITERATE::SIMPLE-EXPAND-GATHERING-FORM +- PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +- WALKER::WALK-NAMED-LAMBDA PCL::FIRST-FORM-TO-LISP +- PCL::ONE-CLASS-DFUN-INFO +- WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL +- PCL::EMIT-GREATER-THAN-1-DLAP PCL::CONVERT-TABLE +- PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +- PCL::INITIALIZE-INTERNAL-SLOT-GFS* +- ITERATE::OPTIMIZE-GATHERING-FORM +- PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +- PCL::OPTIMIZE-SLOT-BOUNDP +- PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +- PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +- PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS +- WALKER::WALK-SYMBOL-MACROLET ITERATE::VARIABLE-SAME-P +- PCL::EMIT-SLOT-READ-FORM +- PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P +- PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +- PCL::GET-FUNCTION-GENERATOR +- PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +- PCL::FIX-SLOT-ACCESSORS +- PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +- PCL::OPTIMIZE-GF-CALL-INTERNAL +- PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +- PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +- PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +- PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- WALKER::WALK-PROG* PCL::ONE-INDEX-DFUN-INFO +- PCL::COMPUTE-PRECEDENCE PCL::TRACE-EMF-CALL-INTERNAL +- WALKER::WALK-MACROLET)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::MAKE-DEFMETHOD-FORM-INTERNAL PCL::LOAD-DEFMETHOD +- PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::GET-EFFECTIVE-METHOD-FUNCTION1 +- PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS +- PCL::MAKE-EMF-FROM-METHOD +- PCL::REAL-ENSURE-GF-USING-CLASS--NULL PCL::PROBE-CACHE +- PCL::MAP-CACHE PCL::GET-DECLARATION +- PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION +- WALKER::CONVERT-MACRO-TO-LAMBDA +- PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION PCL::EMIT-MISS +- PCL::GET-METHOD-FUNCTION-PV-CELL PCL::METHOD-FUNCTION-GET +- PCL::FIND-CLASS-FROM-CELL PCL::RECORD-DEFINITION +- PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 +- PCL::FIND-CLASS-PREDICATE-FROM-CELL +- PCL::NAMED-OBJECT-PRINT-FUNCTION +- PCL::PRECOMPUTE-EFFECTIVE-METHODS PCL::INITIALIZE-INFO +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +- PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 +- PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL +- PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 PCL::MAKE-EMF-CACHE +- PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +- PCL::MAKE-FGEN +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +- PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS +- PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +- PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::OPTIMIZE-ACCESSOR-CALL +- PCL::MAKE-INSTANCE-FUNCTION-COMPLEX PCL::UPDATE-SLOTS-IN-PV +- PCL::COMPUTE-PV-SLOT +- PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| +- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| +- PCL::OPTIMIZE-INSTANCE-ACCESS +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +- PCL::MAKE-INSTANCE-FUNCTION-SIMPLE +- PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::OPTIMIZE-GENERIC-FUNCTION-CALL +- PCL::LOAD-FUNCTION-GENERATOR WALKER::WALK-BINDINGS-1 +- PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +- PCL::REAL-MAKE-METHOD-INITARGS-FORM +- PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +- PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +- WALKER::WALK-TEMPLATE-HANDLE-REPEAT +- PCL::MAKE-PARAMETER-REFERENCES +- PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +- PCL::EXPAND-EMF-CALL-METHOD +- PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| +- PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +- PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::GET-METHOD WALKER::WALK-ARGLIST PCL::REAL-GET-METHOD +- PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-2-LIST +- PCL::FILL-CACHE PCL::CHECK-INITARGS-2-PLIST PCL::MAKE-EMF-CALL +- PCL::CHECK-INITARGS-1 PCL::CAN-OPTIMIZE-ACCESS1)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::GET-SECONDARY-DISPATCH-FUNCTION2)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ PCL::EMIT-N-N-WRITERS PCL::COUNT-ALL-DFUNS ++ PCL::EMIT-N-N-READERS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::REAL-LOAD-DEFCLASS PCL::LOAD-DEFCLASS PCL::SET-ARG-INFO1 +- PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION PCL::EMIT-SLOT-ACCESS +- WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 PCL::OPTIMIZE-GF-CALL +- PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::MAKE-EARLY-CLASS-DEFINITION)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ PCL::GET-EFFECTIVE-METHOD-GENSYM PCL::RENEW-SYS-FILES ++ PCL::UPDATE-DISPATCH-DFUNS PCL::IN-THE-COMPILER-P ++ PCL::SHOW-FREE-CACHE-VECTORS PCL::BOOTSTRAP-BUILT-IN-CLASSES ++ PCL::MAKE-CACHE PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2 ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 ++ PCL::STRUCTURE-FUNCTIONS-EXIST-P PCL::NO-METHODS-DFUN-INFO ++ PCL::SHOW-EMF-CALL-TRACE PCL::INITIAL-DFUN-INFO ++ PCL::DISPATCH-DFUN-INFO PCL::MAKE-ARG-INFO ++ PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST ++ PCL::%%ALLOCATE-INSTANCE--CLASS ++ PCL::INITIAL-DISPATCH-DFUN-INFO PCL::CACHES-TO-ALLOCATE ++ PCL::MAKE-CPD PCL::LIST-ALL-DFUNS PCL::SHOW-DFUN-CONSTRUCTORS ++ PCL::BOOTSTRAP-META-BRAID PCL::DEFAULT-METHOD-ONLY-DFUN-INFO)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::FIXNUM) +- COMMON-LISP::T) +- PCL::GET-CACHE PCL::FILL-CACHE-FROM-CACHE-P)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN) ++ PCL::CACHE-VALUEP)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) +- COMMON-LISP::FIXNUM) +- PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) ++ PCL::CACHE-FIELD)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- PCL::EVAL-FORM PCL::EARLY-CLASS-NAME-OF PCL::DFUN-INFO-CACHE +- PCL::MAKE-CONSTANT-FUNCTION PCL::EXPAND-SHORT-DEFCOMBIN +- PCL::COPY-CACHE PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES +- PCL::MAKE-INITIAL-DFUN PCL::ECD-METACLASS +- PCL::EXTRACT-SPECIALIZER-NAMES PCL::GBOUNDP +- PCL::GET-SETF-FUNCTION-NAME PCL::USE-CACHING-DFUN-P +- PCL::INITIALIZE-INFO-CACHED-CONSTANTS +- PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS COMMON-LISP::CLASS-OF +- PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION +- PCL::ARG-INFO-KEY/REST-P PCL::METHOD-CALL-CALL-METHOD-ARGS +- PCL::FGEN-GENSYMS PCL::EARLY-CLASS-PRECEDENCE-LIST +- PCL::EARLY-SLOT-DEFINITION-LOCATION +- PCL::EXPAND-MAKE-INSTANCE-FORM PCL::INTERN-EQL-SPECIALIZER +- PCL::METHOD-FUNCTION-METHOD PCL::FGEN-GENERATOR-LAMBDA +- PCL::SLOT-READER-SYMBOL PCL::CACHING-P +- PCL::EARLY-METHOD-QUALIFIERS +- PCL::EARLY-COLLECT-DEFAULT-INITARGS PCL::KEYWORD-SPEC-NAME +- PCL::ONE-INDEX-P PCL::COMPLICATED-INSTANCE-CREATION-METHOD +- PCL::DFUN-ARG-SYMBOL PCL::N-N-CACHE +- PCL::ONE-INDEX-DFUN-INFO-INDEX PCL::INITIAL-DISPATCH-CACHE +- PCL::CPD-CLASS PCL::FAST-METHOD-CALL-ARG-INFO +- PCL::MAKE-PV-TYPE-DECLARATION PCL::COMPUTE-STD-CPL-PHASE-2 +- PCL::GET-BUILT-IN-CLASS-SYMBOL +- PCL::INITIALIZE-INFO-CACHED-RI-VALID-P +- PCL::UPDATE-GFS-OF-CLASS PCL::STRUCTURE-SVUC-METHOD +- PCL::SLOT-BOUNDP-SYMBOL PCL::FGEN-SYSTEM +- PCL::FIND-CYCLE-REASONS ITERATE::SEQUENCE-ACCESSOR +- PCL::GF-INFO-C-A-M-EMF-STD-P PCL::STRUCTURE-TYPE-P +- PCL::TWO-CLASS-CACHE PCL::METHOD-LL->GENERIC-FUNCTION-LL +- PCL::ONE-CLASS-ACCESSOR-TYPE PCL::WRAPPER-FOR-STRUCTURE +- PCL::ACCESSOR-DFUN-INFO-CACHE PCL::%SYMBOL-FUNCTION +- PCL::STRUCTURE-TYPE PCL::NET-TEST-CONVERTER +- PCL::CONSTANT-SYMBOL-P PCL::GMAKUNBOUND PCL::INITIAL-P +- PCL::GF-DFUN-CACHE PCL::STRUCTURE-SLOTD-TYPE +- PCL::%STD-INSTANCE-WRAPPER PCL::INITIALIZE-INFO-P +- PCL::CACHING-DFUN-INFO +- PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::FAST-METHOD-CALL-P PCL::GF-DFUN-INFO +- PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::ECD-CLASS-NAME +- PCL::MAKE-INSTANCE-FUNCTION-SYMBOL +- PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION +- PCL::STD-INSTANCE-P PCL::EXTRACT-PARAMETERS +- WALKER::GET-WALKER-TEMPLATE PCL::SYMBOL-PKG-NAME +- PCL::CCLOSUREP PCL::LOOKUP-FGEN PCL::CPD-SUPERS +- PCL::ARG-INFO-KEYWORDS PCL::DISPATCH-P +- PCL::INITIALIZE-INFO-CACHED-NEW-KEYS +- PCL::MAKE-CALLS-TYPE-DECLARATION PCL::INITIALIZE-INFO-WRAPPER +- PCL::%FBOUNDP PCL::DEFAULT-STRUCTURE-INSTANCE-P +- WALKER::ENV-WALK-FORM PCL::EARLY-CLASS-DEFINITION +- PCL::SORT-CALLS PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME +- PCL::DISPATCH-CACHE PCL::INITIALIZE-INFO-KEY +- PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +- PCL::ARG-INFO-METATYPES PCL::GF-LAMBDA-LIST +- WALKER::ENV-LEXICAL-VARIABLES PCL::ACCESSOR-DFUN-INFO-P +- PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::COMPUTE-LINE-SIZE +- PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION +- PCL::FORCE-CACHE-FLUSHES PCL::TWO-CLASS-P PCL::DFUN-INFO-P +- PCL::MAP-SPECIALIZERS PCL::MAKE-PERMUTATION-VECTOR +- WALKER::ENV-LOCK PCL::CPD-AFTER PCL::EARLY-CLASS-SLOTS +- PCL::GET-PV-CELL-FOR-CLASS PCL::ARG-INFO-P +- PCL::EXTRACT-REQUIRED-PARAMETERS +- PCL::STRUCTURE-SLOTD-READER-FUNCTION PCL::COMPUTE-CLASS-SLOTS +- PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS +- PCL::TWO-CLASS-WRAPPER0 +- PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL +- PCL::COMPILE-LAMBDA-UNCOMPILED PCL::EARLY-CLASS-NAME +- PCL::SFUN-P PCL::EXTRACT-LAMBDA-LIST PCL::UNDEFMETHOD-1 +- PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::WRAPPER-OF +- PCL::ARG-INFO-LAMBDA-LIST PCL::LIST-DFUN +- PCL::NEXT-WRAPPER-FIELD PCL::CHECK-WRAPPER-VALIDITY +- PCL::STRUCTURE-SLOTD-NAME PCL::BUILT-IN-WRAPPER-OF +- PCL::GET-MAKE-INSTANCE-FUNCTIONS +- PCL::GENERIC-CLOBBERS-FUNCTION PCL::NO-METHODS-P +- PCL::CONSTANT-VALUE-P WALKER::ENV-WALK-FUNCTION +- PCL::INITIAL-CACHE PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD +- PCL::MAKE-CLASS-EQ-PREDICATE +- PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL +- PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS +- PCL::FUNCTION-PRETTY-ARGLIST +- PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST PCL::TYPE-CLASS +- PCL::CHECK-CACHE PCL::STANDARD-SVUC-METHOD +- PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::GF-INFO-FAST-MF-P +- PCL::STRUCTURE-SLOTD-WRITER-FUNCTION +- PCL::BOOTSTRAP-CLASS-PREDICATES PCL::DEFAULT-METHOD-ONLY-CACHE +- PCL::GET-CACHE-VECTOR PCL::SLOT-WRITER-SYMBOL +- PCL::FGEN-GENERATOR PCL::DNET-METHODS-P +- PCL::DEFAULT-STRUCTURE-TYPE +- PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST +- PCL::N-N-ACCESSOR-TYPE +- PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST +- WALKER::ENV-DECLARATIONS WALKER::VARIABLE-GLOBALLY-SPECIAL-P +- PCL::ONE-INDEX-INDEX PCL::ONE-INDEX-DFUN-INFO-CACHE +- PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::EARLY-CLASS-SLOTDS +- PCL::CANONICAL-SLOT-NAME PCL::EARLY-COLLECT-CPL +- PCL::RESET-CLASS-INITIALIZE-INFO-1 +- PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::ONE-INDEX-CACHE +- PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION +- PCL::MAKE-TYPE-PREDICATE PCL::FREE-CACHE +- ITERATE::VARIABLES-FROM-LET +- PCL::EARLY-METHOD-STANDARD-ACCESSOR-P +- PCL::DEFAULT-CONSTANT-CONVERTER PCL::CLASS-PREDICATE +- PCL::CHECKING-CACHE PCL::ARG-INFO-PRECEDENCE +- PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P +- PCL::DEFAULT-METHOD-ONLY-P +- PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P +- PCL::STRUCTURE-SLOT-BOUNDP PCL::ONE-INDEX-ACCESSOR-TYPE +- PCL::TWO-CLASS-ACCESSOR-TYPE +- PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P PCL::METHOD-CALL-P +- PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::CONSTANT-VALUE-DFUN-INFO +- PCL::COMPILE-LAMBDA-DEFERRED PCL::SETFBOUNDP +- PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P +- PCL::PV-TABLEP PCL::STRUCTURE-OBJECT-P PCL::TWO-CLASS-INDEX +- PCL::METHOD-FUNCTION-PV-TABLE PCL::ECD-OTHER-INITARGS +- WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE +- PCL::EARLY-GF-P PCL::STRUCTURE-SLOTD-INIT-FORM +- PCL::FUNCALLABLE-INSTANCE-P PCL::CHECKING-FUNCTION +- PCL::FUNCTION-RETURNING-NIL PCL::FUNCTION-RETURNING-T +- PCL::UPDATE-C-A-M-GF-INFO PCL::COUNT-DFUN +- PCL::UNPARSE-SPECIALIZERS PCL::CACHE-OWNER +- PCL::EARLY-METHOD-CLASS +- PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION +- PCL::EARLY-SLOT-DEFINITION-NAME +- PCL::GET-MAKE-INSTANCE-FUNCTION +- PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME +- PCL::ECD-SUPERCLASS-NAMES PCL::GFS-OF-TYPE PCL::SORT-SLOTS +- PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS +- PCL::COMPUTE-MCASE-PARAMETERS PCL::METHOD-FUNCTION-PLIST +- PCL::ARG-INFO-NKEYS PCL::FINAL-ACCESSOR-DFUN-TYPE +- PCL::EARLY-COLLECT-SLOTS PCL::EARLY-METHOD-LAMBDA-LIST +- PCL::FAST-INSTANCE-BOUNDP-P PCL::GDEFINITION +- PCL::%CCLOSURE-ENV SYSTEM::%COMPILED-FUNCTION-NAME +- PCL::RESET-INITIALIZE-INFO PCL::ARG-INFO-NUMBER-OPTIONAL +- PCL::RESET-CLASS-INITIALIZE-INFO +- PCL::INITIALIZE-INFO-CACHED-VALID-P PCL::INTERNED-SYMBOL-P +- PCL::EARLY-GF-NAME PCL::FGEN-TEST PCL::MAKE-INITFUNCTION +- PCL::MAP-ALL-GENERIC-FUNCTIONS PCL::SHOW-DFUN-COSTS +- PCL::CLASS-FROM-TYPE PCL::EXPAND-LONG-DEFCOMBIN +- PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION +- PCL::FREE-CACHE-VECTOR PCL::%STD-INSTANCE-SLOTS +- PCL::ALLOCATE-CACHE-VECTOR PCL::ONE-CLASS-P +- PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::SLOT-VECTOR-SYMBOL +- PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION +- PCL::ONE-CLASS-WRAPPER0 PCL::N-N-P +- PCL::UPDATE-ALL-C-A-M-GF-INFO PCL::CHECKING-P +- PCL::TWO-CLASS-WRAPPER1 PCL::PARSE-SPECIALIZERS +- PCL::FORMAT-CYCLE-REASONS PCL::FLUSH-CACHE-VECTOR-INTERNAL +- PCL::UNENCAPSULATED-FDEFINITION PCL::ONE-CLASS-INDEX +- PCL::DEFAULT-CONSTANTP PCL::UPDATE-GF-INFO +- PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE +- PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST +- PCL::MAKE-EQL-PREDICATE PCL::ARG-INFO-VALID-P +- PCL::CACHING-CACHE PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION +- PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL +- PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION +- PCL::MAKE-FUNCTION-INLINE PCL::STORE-FGEN +- PCL::LIST-LARGE-CACHE PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P +- PCL::ARG-INFO-APPLYP SYSTEM::%STRUCTURE-NAME +- PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::ECD-SOURCE +- PCL::EARLY-CLASS-DIRECT-SUBCLASSES +- PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::DEFAULT-TEST-CONVERTER +- PCL::MAKE-CALL-METHODS PCL::GET-BUILT-IN-WRAPPER-SYMBOL +- PCL::GF-INFO-STATIC-C-A-M-EMF PCL::DEFAULT-STRUCTUREP +- PCL::CONSTANT-VALUE-CACHE PCL::INITIAL-DISPATCH-P +- PCL::ECD-CANONICAL-SLOTS PCL::WRAPPER-FIELD +- PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE PCL::ONE-CLASS-CACHE +- PCL::CACHING-DFUN-COST PCL::LEGAL-CLASS-NAME-P +- PCL::INTERN-FUNCTION-NAME PCL::FAST-METHOD-CALL-PV-CELL +- PCL::CACHE-P PCL::ONE-INDEX-DFUN-INFO-P +- PCL::MAKE-PV-TABLE-TYPE-DECLARATION PCL::NO-METHODS-CACHE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ PCL::ONE-INDEX-LIMIT-FN PCL::EARLY-CLASS-SIZE PCL::CACHE-COUNT ++ PCL::PV-TABLE-PV-SIZE PCL::DEFAULT-LIMIT-FN ++ PCL::CHECKING-LIMIT-FN PCL::CACHING-LIMIT-FN ++ PCL::N-N-ACCESSORS-LIMIT-FN PCL::CPD-COUNT ++ PCL::FAST-INSTANCE-BOUNDP-INDEX PCL::ARG-INFO-NUMBER-REQUIRED ++ PCL::PV-CACHE-LIMIT-FN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD +- COMMON-LISP::METHOD-COMBINATION-ERROR +- COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++ PCL::POWER-OF-TWO-CEILING)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(PCL::TRACE-METHOD-INTERNAL PCL::FDEFINE-CAREFULLY ++ PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++ PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::T) +- PCL::COMPUTE-STD-CPL-PHASE-3)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::INTEGER 1 255)) ++ PCL::CACHE-NKEYS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::EXPAND-DEFMETHOD PCL::LOAD-DEFMETHOD-INTERNAL)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::INTEGER 1 256)) ++ PCL::CACHE-LINE-SIZE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) + COMMON-LISP::T) +- PCL::BOOTSTRAP-INITIALIZE-CLASS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) +- PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW +- PCL::PV-TABLE-SLOT-NAME-LISTS)) ++ PCL::%CCLOSURE-ENV-NTHCDR)) + (IN-PACKAGE "PCL") + +-(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| ++(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)| + |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)| + |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)| + |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| + |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| +@@ -1063,16 +1148,17 @@ + COMPATIBLE-META-CLASS-CHANGE-P + |(FAST-READER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| + |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)| +- |(BOUNDP READER-FUNCTION)| |(BOUNDP PREDICATE-NAME)| +- |(BOUNDP READERS)| UPDATE-GF-DFUN +- |(BOUNDP CLASS-PRECEDENCE-LIST)| ++ |(BOUNDP READER-FUNCTION)| TRACE-METHOD-INTERNAL ++ |(BOUNDP PREDICATE-NAME)| |(BOUNDP READERS)| ++ UPDATE-GF-DFUN |(BOUNDP CLASS-PRECEDENCE-LIST)| + |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)| + |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT + |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)| + ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)| + |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| +- SPECIALIZER-CLASS |(BOUNDP PRETTY-ARGLIST)| ++ REDEFINE-FUNCTION SPECIALIZER-CLASS ++ |(BOUNDP PRETTY-ARGLIST)| + |PCL::PCL-CLASS class predicate| + |PCL::STD-CLASS class predicate| + |(BOUNDP DEFSTRUCT-FORM)| +@@ -1110,104 +1196,104 @@ + |(BOUNDP OPTIONS)| |(WRITER METHOD)| + |PCL::DEPENDENT-UPDATE-MIXIN class predicate| + GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)| +- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| +- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| + |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +- |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| + |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| ++ |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++ |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| + |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| ++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| + |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +- |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| +- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| +- |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| + |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| + MAKE-BOUNDP-METHOD-FUNCTION + |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| + |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| + |PCL::METAOBJECT class predicate| +- |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +- |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++ |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| + |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| +- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| + |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++ |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| + |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +- |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| +- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| + |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++ |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++ |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++ |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++ |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +- |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| +- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++ |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| + |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| + |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +- |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++ |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++ |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| + |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++ |(FAST-METHOD MAKE-INSTANCE (CLASS))| ++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| + |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| + |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| +- |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +- |(FAST-METHOD MAKE-INSTANCE (CLASS))| ++ |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| + |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +- |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +- |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| + CLASS-PREDICATE-NAME + |PCL::STRUCTURE-SLOT-DEFINITION class predicate| + |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| +@@ -1233,8 +1319,8 @@ + |(WRITER PREDICATE-NAME)| |(WRITER READERS)| + |(READER WRITER-FUNCTION)| |(READER INITFUNCTION)| + INITIALIZE-INTERNAL-SLOT-FUNCTIONS +- |SETF PCL SLOT-DEFINITION-TYPE| +- |(WRITER CLASS-PRECEDENCE-LIST)| |(READER WRITERS)| ++ |SETF PCL SLOT-DEFINITION-TYPE| |(READER WRITERS)| ++ |(WRITER CLASS-PRECEDENCE-LIST)| + |(WRITER ACCESSOR-FLAGS)| |(READER INITFORM)| + METHOD-COMBINATION-P |(WRITER LOCATION)| + |(WRITER DOCUMENTATION)| +@@ -1248,11 +1334,11 @@ + |(READER ALLOCATION)| |(WRITER SPECIALIZERS)| + |(CALL REAL-ENSURE-GF-USING-CLASS--NULL)| + |(WRITER IDENTITY-WITH-ONE-ARGUMENT)| +- |(SETF METHOD-GENERIC-FUNCTION)| LEGAL-SPECIALIZERS-P +- |(WRITER PRETTY-ARGLIST)| |SETF PCL OBJECT-PLIST| +- |(WRITER DEFSTRUCT-FORM)| |(READER FUNCTION)| +- |(READER GENERIC-FUNCTION)| |(READER LAMBDA-LIST)| +- |(READER SLOT-DEFINITION)| ++ |(SETF METHOD-GENERIC-FUNCTION)| ++ |(WRITER PRETTY-ARGLIST)| LEGAL-SPECIALIZERS-P ++ |SETF PCL OBJECT-PLIST| |(WRITER DEFSTRUCT-FORM)| ++ |(READER FUNCTION)| |(READER GENERIC-FUNCTION)| ++ |(READER LAMBDA-LIST)| |(READER SLOT-DEFINITION)| + |PCL::CLASS-PROTOTYPE-SPECIALIZER class predicate| + |SETF PCL SLOT-DEFINITION-INITFORM| + |SETF PCL CLASS-DEFSTRUCT-FORM| +@@ -1273,17 +1359,16 @@ + |SETF PCL SLOT-DEFINITION-ALLOCATION| + |SETF PCL SLOT-DEFINITION-INITFUNCTION| + |(WRITER SLOT-NAME)| |(BOUNDP NAME)| +- |(WRITER ALLOCATION)| |(READER FAST-FUNCTION)| ++ |(READER FAST-FUNCTION)| |(WRITER ALLOCATION)| + |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)| + |(READER INTERNAL-WRITER-FUNCTION)| + |(READER INTERNAL-READER-FUNCTION)| + |(READER METHOD-COMBINATION)| + METHOD-COMBINATION-OPTIONS |(READER DIRECT-SLOTS)| + |(READER DIRECT-METHODS)| +- |SETF PCL SLOT-DEFINITION-READERS| +- |(READER BOUNDP-FUNCTION)| |(WRITER FUNCTION)| +- |(WRITER GENERIC-FUNCTION)| |SETF PCL DOCUMENTATION| +- |(READER DIRECT-SUBCLASSES)| ++ |SETF PCL SLOT-DEFINITION-READERS| |(WRITER FUNCTION)| ++ |(WRITER GENERIC-FUNCTION)| |(READER BOUNDP-FUNCTION)| ++ |SETF PCL DOCUMENTATION| |(READER DIRECT-SUBCLASSES)| + |(READER DIRECT-SUPERCLASSES)| |(WRITER LAMBDA-LIST)| + FUNCALLABLE-STANDARD-CLASS-P + |(FAST-WRITER-METHOD SLOT-OBJECT METHOD)| +@@ -1294,7 +1379,7 @@ + |SETF PCL SLOT-VALUE-USING-CLASS| + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| + |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| +- |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)| ++ |(WRITER PROTOTYPE)| |(BOUNDP TYPE)| |(BOUNDP OBJECT)| + CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS| + |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION + |(BOUNDP PLIST)| +@@ -1309,11 +1394,11 @@ + |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| + |PCL::PLIST-MIXIN class predicate| + |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| GET-METHOD + |(WRITER INTERNAL-WRITER-FUNCTION)| + |(WRITER INTERNAL-READER-FUNCTION)| +- |(WRITER METHOD-COMBINATION)| GET-METHOD +- |(WRITER DIRECT-SLOTS)| |(WRITER DIRECT-METHODS)| ++ |(WRITER METHOD-COMBINATION)| |(WRITER DIRECT-SLOTS)| ++ |(WRITER DIRECT-METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)| +@@ -1383,18 +1468,18 @@ + |(FAST-READER-METHOD SLOT-DEFINITION READERS)| + |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| +- |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| +- |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-READER-METHOD SPECIALIZER TYPE)| + |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)| + |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)| ++ |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| ++ |(FAST-READER-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| ++ |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)| + |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)| + |(FAST-READER-METHOD SLOT-OBJECT OBJECT)| + |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)| +- |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| +- |(FAST-READER-METHOD SLOT-OBJECT TYPE)| +- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| + |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| + |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| +@@ -1416,11 +1501,11 @@ + |(FAST-READER-METHOD SLOT-CLASS SLOTS)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)| + |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)| +- |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-READER-METHOD SLOT-OBJECT METHODS)| + |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| + |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)| ++ |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| + |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| +@@ -1458,8 +1543,8 @@ + |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| + |(SETF SLOT-VALUE-USING-CLASS)| +@@ -1485,10 +1570,10 @@ + |(SETF SLOT-DEFINITION-TYPE)| + |(SETF SLOT-DEFINITION-INITFORM)| + |(BOUNDP INITIALIZE-INFO)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| +@@ -1498,94 +1583,94 @@ + GENERIC-FUNCTION-P + |PCL::SLOT-DEFINITION class predicate| |(READER NAME)| + |(READER CLASS)| +- |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +- |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +- |(FAST-METHOD DESCRIBE-OBJECT (T T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| ++ |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++ |(FAST-METHOD SLOT-UNBOUND (T T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ |(FAST-METHOD (SETF DOCUMENTATION) (T T))| + |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++ |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| + |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +- |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| + |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| ++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++ |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD PRINT-OBJECT (CLASS T))| ++ |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| + |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++ |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| + |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +- |(FAST-METHOD PRINT-OBJECT (CLASS T))| +- |(FAST-METHOD PRINT-OBJECT (T T))| +- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++ |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++ |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| + |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| + |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| + |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++ |(FAST-METHOD PRINT-OBJECT (T T))| ++ |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| + |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +- |(FAST-METHOD (SETF DOCUMENTATION) (T T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +- |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++ |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++ |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++ |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| + |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +- |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +- |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (T T))| + |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +- |(FAST-METHOD SLOT-UNBOUND (T T T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| + |(FAST-METHOD SLOT-MISSING (T T T T))| +- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| +- |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +- LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)| ++ |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++ LEGAL-SLOT-NAME-P |(READER TYPE)| |(READER OBJECT)| + CLASS-WRAPPER |(READER PLIST)| + |(FAST-METHOD CLASS-PREDICATE-NAME (T))| + |(FAST-METHOD DOCUMENTATION (T))| + |(FAST-METHOD NO-APPLICABLE-METHOD (T))| + |(READER SLOTS)| |(WRITER NAME)| DEFINITION-SOURCE + |PCL::SLOT-OBJECT class predicate| DEFAULT-INITARGS +- |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER OBJECT)| +- |(WRITER TYPE)| ++ |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER TYPE)| ++ |(WRITER OBJECT)| + |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| + |(WRITER PLIST)| |(WRITER SLOTS)| + |PCL::DOCUMENTATION-MIXIN class predicate| +@@ -1625,10 +1710,10 @@ + |COMMON-LISP::STANDARD-OBJECT class predicate| + |COMMON-LISP::BUILT-IN-CLASS class predicate| + |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-SLOTS)| +- |(SETF CLASS-DIRECT-SLOTS)| |(READER OPERATOR)| +- |(CALL REAL-GET-METHOD)| |(CALL REAL-REMOVE-METHOD)| +- |(CALL REAL-ADD-METHOD)| |(READER ARG-INFO)| +- METHOD-COMBINATION-TYPE ++ |(SETF CLASS-DIRECT-SLOTS)| DO-STANDARD-DEFSETF-1 ++ |(READER OPERATOR)| |(CALL REAL-GET-METHOD)| ++ |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-ADD-METHOD)| ++ |(READER ARG-INFO)| METHOD-COMBINATION-TYPE + |(READER DEFSTRUCT-CONSTRUCTOR)| + |(INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| + |(READER INITIALIZE-INFO)| |(WRITER WRAPPER)| +@@ -1637,8 +1722,8 @@ + |(WRITER DEFSTRUCT-ACCESSOR-SYMBOL)| + COMPUTE-SLOT-ACCESSOR-INFO |(READER INITARGS)| + |(WRITER CLASS-EQ-SPECIALIZER)| +- STANDARD-BOUNDP-METHOD-P |(SETF DOCUMENTATION)| +- RAW-INSTANCE-ALLOCATOR ++ STANDARD-BOUNDP-METHOD-P FDEFINE-CAREFULLY ++ |(SETF DOCUMENTATION)| RAW-INSTANCE-ALLOCATOR + |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| + |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)| + |(WRITER ARG-INFO)| +@@ -1651,9 +1736,8 @@ + METHOD-COMBINATION-DOCUMENTATION + |SETF PCL SLOT-DEFINITION-INITARGS| + REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD +- |(WRITER INITARGS)| + |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| +- |(BOUNDP METHOD)| ++ |(WRITER INITARGS)| |(BOUNDP METHOD)| + |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)| + |(FAST-WRITER-METHOD CLASS NAME)| + |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| +@@ -1699,11 +1783,11 @@ + |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| + |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)| +- |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| + |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)| + |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| + REMOVE-NAMED-METHOD + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| +@@ -1756,5 +1840,6 @@ + ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD + SLOT-DEFINITION-WRITERS + COMPUTE-APPLICABLE-METHODS-USING-CLASSES +- CLASS-PRECEDENCE-LIST DESCRIBE-OBJECT)) ++ CLASS-PRECEDENCE-LIST DISASSEMBLE DESCRIBE-OBJECT ++ COMPILE)) + (SETF (GET V 'COMPILER::PROCLAIMED-CLOSURE) T)) +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -79,7 +79,7 @@ + #+ansi-cl (use-package :pcl :user) + + (import 'si::(clines defentry defcfun object void int double quit bye gbc system +- *lib-directory* *system-directory*) :user) ++ *lib-directory* *system-directory* while) :user) + + (let* ((i 4096)(j (si::equal-tail-recursion-check i))) + (unless (<= (ash i -1) j) diff --git a/patches/list_order.11 b/patches/list_order.11 new file mode 100644 index 00000000..b97390c9 --- /dev/null +++ b/patches/list_order.11 @@ -0,0 +1,600 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-53) unstable; urgency=medium + . + * list_order.9 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-08-23 + +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -35,12 +35,6 @@ int line_length = 72; + #define WRITEC_NEWLINE(strm) (writec_stream('\n',strm)) + #endif + +-#define to_be_escaped(c) \ +- (standard_readtable->rt.rt_self[(c)&0377].rte_chattrib \ +- != cat_constituent || \ +- isLower((c)&0377) || (c) == ':') +- +- + #define READ_TABLE_CASE (Vreadtable->s.s_dbind->rt.rt_case) + + #define mod(x) ((x)%Q_SIZE) +@@ -637,50 +631,31 @@ constant_case(object x) { + } + + static int +-all_dots(object x) { +- +- fixnum i; +- +- for (i=0;is.s_fillp;i++) +- if (x->s.s_self[i]!='.') +- return 0; ++needs_escape (object x) { + +- return 1; +- +-} +- +-static int +-needs_escape (object x,int pp) { +- +- fixnum i; +- char ch; ++ fixnum i,all_dots=1; ++ int ch; + + if (!PRINTescape) + return 0; + + for (i=0;is.s_fillp;i++) + switch((ch=x->s.s_self[i])) { +- case '(': +- case ')': + case ':': +- case '`': +- case '\'': +- case '"': +- case ';': +- case ',': +- case '\n': + return 1; +- case ' ': +- if (!i) return 1; ++ case '.': ++ break; + default: ++ all_dots=0; ++ if (Vreadtable->s.s_dbind->rt.rt_self[ch].rte_chattrib!=cat_constituent) ++ return 1; + if ((READ_TABLE_CASE==sKupcase && isLower(ch)) || + (READ_TABLE_CASE==sKdowncase && isUpper(ch))) + return 1; + } + +- if (pp) +- if (potential_number_p(x, PRINTbase) || all_dots(x)) +- return 1; ++ if (potential_number_p(x, PRINTbase) || all_dots) ++ return 1; + + return !x->s.s_fillp; + +@@ -690,19 +665,21 @@ needs_escape (object x,int pp) { + #define convertible_lower(c) ((READ_TABLE_CASE==sKdowncase||READ_TABLE_CASE==sKinvert)&& isLower(c)) + + static void +-print_symbol_name_body(object x,int pp) { ++print_symbol_name_body(object x) { + + int i,j,fc,tc,lw,k,cc; + + cc=constant_case(x); +- k=needs_escape(x,pp); ++ k=needs_escape(x); + + if (k) + write_ch('|'); + + for (lw=i=0;is.s_fillp;i++) { + j = x->s.s_self[i]; +- if (PRINTescape && (j == '|' || j == '\\')) ++ if (PRINTescape && ++ (Vreadtable->s.s_dbind->rt.rt_self[j].rte_chattrib==cat_single_escape || ++ Vreadtable->s.s_dbind->rt.rt_self[j].rte_chattrib==cat_multiple_escape)) + write_ch('\\'); + fc=convertible_upper(j) ? 1 : + (convertible_lower(j) ? -1 : 0); +@@ -711,7 +688,7 @@ print_symbol_name_body(object x,int pp) + (PRINTcase == sKdowncase ? -1 : + (PRINTcase == sKcapitalize ? (i==lw ? 1 : -1) : 0)))); + if (ispunct(j)||isspace(j)) lw=i+1; +- j+=(tc*fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); ++ j+=(tc && fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); + write_ch(j); + + } +@@ -721,6 +698,42 @@ print_symbol_name_body(object x,int pp) + + } + ++#define DONE 1 ++#define FOUND -1 ++ ++static int ++write_sharp_eq(object *vp,bool dot) { ++ ++ bool defined=vp[1]!=Cnil; ++ ++ if (dot) { ++ write_str(" . "); ++ if (!defined) return FOUND; ++ } ++ ++ vp[1]=Ct; ++ write_ch('#'); ++ write_decimal((vp-PRINTvs_top)/2); ++ write_ch(defined ? '#' : '='); ++ ++ return defined ? DONE : FOUND; ++ ++} ++ ++static int ++write_sharp_eqs(object x,bool dot) { ++ ++ object *vp; ++ ++ for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) ++ if (x == *vp) ++ return write_sharp_eq(vp,dot); ++ ++ return 0; ++ ++} ++ ++ + void + write_object(x, level) + object x; +@@ -728,7 +741,6 @@ int level; + { + object r, y; + int i, j, k; +- object *vp; + + cs_check(x); + +@@ -903,29 +915,15 @@ int level; + + if (PRINTescape) { + if (x->s.s_hpack == Cnil) { +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2+1); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2+1); +- write_ch('='); +- vp[1] = Ct; +- } +- } +- } ++ if (PRINTcircle) ++ if (write_sharp_eqs(x,FALSE)==DONE) return; + if (PRINTgensym) + write_str("#:"); + } else if (x->s.s_hpack == keyword_package) { + write_ch(':'); + } else if (PRINTpackage||find_symbol(x,current_package())!=x || !intern_flag) { + +- print_symbol_name_body(x->s.s_hpack->p.p_name,0); ++ print_symbol_name_body(x->s.s_hpack->p.p_name); + + if (find_symbol(x, x->s.s_hpack) != x) + error("can't print symbol"); +@@ -939,7 +937,7 @@ int level; + } + + } +- print_symbol_name_body(x,1); ++ print_symbol_name_body(x); + break; + } + case t_array: +@@ -953,23 +951,8 @@ int level; + write_str(">"); + break; + } +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('='); +- vp[1] = Ct; +- break; +- } +- } +- } ++ if (PRINTcircle) ++ if (write_sharp_eqs(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1044,23 +1027,8 @@ int level; + write_str(">"); + break; + } +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('='); +- vp[1] = Ct; +- break; +- } +- } +- } ++ if (PRINTcircle) ++ if (write_sharp_eqs(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1130,23 +1098,8 @@ int level; + write_object(x->c.c_cdr, level); + break; + } +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('='); +- vp[1] = Ct; +- break; +- } +- } +- } ++ if (PRINTcircle) ++ if (write_sharp_eqs(x,FALSE)==DONE) return; + if (PRINTpretty) { + if (x->c.c_car == sLquote && + type_of(x->c.c_cdr) == t_cons && +@@ -1192,22 +1145,15 @@ int level; + } + break; + } +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_str(" . #"); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- goto RIGHT_PAREN; +- } else { +- write_ch(INDENT); +- write_str(". "); +- write_object(x, level); +- goto RIGHT_PAREN; +- } +- } +- } ++ if (PRINTcircle) ++ switch (write_sharp_eqs(x,TRUE)) { ++ case FOUND: ++ write_object(x, level); ++ case DONE: ++ goto RIGHT_PAREN; ++ default: ++ break; ++ } + if (i == 0 && y != OBJNULL && type_of(y) == t_symbol) + write_ch(INDENT1); + else +@@ -1369,23 +1315,8 @@ int level; + break; + + case t_structure: +- if (PRINTcircle) { +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) { +- if (vp[1] != Cnil) { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('#'); +- return; +- } else { +- write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); +- write_ch('='); +- vp[1] = Ct; +- break; +- } +- } +- } ++ if (PRINTcircle) ++ if (write_sharp_eqs(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1468,48 +1399,73 @@ static int dgs; + + #include "page.h" + ++#define travel_seen(x) x->d.m ++#define travel_pushed(x) x->d.f ++#define travel_bits(x) x->md.mf ++ + static void +-travel_push_new(object x) { ++travel_push(object x) { + +- object y; + int i; + +- BEGIN: +- if (NULL_OR_ON_C_STACK(x)) return; +- if (is_marked(x)) { +- vs_check_push(x); +- vs_check_push(Cnil); ++ if (NULL_OR_ON_C_STACK(x)) ++ return; ++ ++ if (travel_seen(x)) { ++ ++ if (!travel_pushed(x)) { ++ vs_check_push(x); ++ vs_check_push(Cnil); ++ travel_pushed(x)=1; ++ } ++ + return; ++ + } ++ + switch (type_of(x)) { ++ + case t_symbol: +- if (dgs && x->s.s_hpack==Cnil) {mark(x);} ++ ++ if (dgs && x->s.s_hpack==Cnil) ++ travel_seen(x)=1; + break; ++ + case t_cons: +- y=x->c.c_cdr; +- mark(x); +- travel_push_new(x->c.c_car); +- x=y; +- goto BEGIN; ++ ++ { ++ object y=x->c.c_cdr; ++ travel_seen(x)=1; ++ travel_push(x->c.c_car); ++ travel_push(y); ++ } + break; ++ + case t_array: +- mark(x); ++ ++ travel_seen(x)=1; + if ((enum aelttype)x->a.a_elttype == aet_object) + for (i=0;ia.a_dim;i++) +- travel_push_new(x->a.a_self[i]); ++ travel_push(x->a.a_self[i]); + break; ++ + case t_vector: +- mark(x); ++ ++ travel_seen(x)=1; + if ((enum aelttype)x->v.v_elttype == aet_object) + for (i=0;iv.v_fillp;i++) +- travel_push_new(x->v.v_self[i]); ++ travel_push(x->v.v_self[i]); + break; ++ + case t_structure: +- mark(x); ++ ++ travel_seen(x)=1; + for (i = 0; i < S_DATA(x->str.str_def)->length; i++) +- travel_push_new(structure_ref(x,x->str.str_def,i)); ++ travel_push(structure_ref(x,x->str.str_def,i)); + break; ++ + default: ++ + break; + + } +@@ -1518,34 +1474,45 @@ travel_push_new(object x) { + + + static void +-travel_clear_new(object x) { ++travel_clear(object x) { + + int i; + +- BEGIN: +- if (NULL_OR_ON_C_STACK(x) || !is_marked(x)) return; +- unmark(x); ++ if (NULL_OR_ON_C_STACK(x) || !travel_bits(x)) ++ return; ++ ++ travel_bits(x)=0; ++ + switch (type_of(x)) { ++ + case t_cons: +- travel_clear_new(x->c.c_car); +- x=x->c.c_cdr; +- goto BEGIN; ++ ++ travel_clear(x->c.c_car); ++ travel_clear(x->c.c_cdr); + break; ++ + case t_array: ++ + if ((enum aelttype)x->a.a_elttype == aet_object) + for (i=0;ia.a_dim;i++) +- travel_clear_new(x->a.a_self[i]); ++ travel_clear(x->a.a_self[i]); + break; ++ + case t_vector: ++ + if ((enum aelttype)x->v.v_elttype == aet_object) + for (i=0;iv.v_fillp;i++) +- travel_clear_new(x->v.v_self[i]); ++ travel_clear(x->v.v_self[i]); + break; ++ + case t_structure: ++ + for (i = 0; i < S_DATA(x->str.str_def)->length; i++) +- travel_clear_new(structure_ref(x,x->str.str_def,i)); ++ travel_clear(structure_ref(x,x->str.str_def,i)); + break; ++ + default: ++ + break; + + } +@@ -1558,74 +1525,14 @@ setupPRINTcircle(object x,int dogensyms) + + BEGIN_NO_INTERRUPT; + dgs=dogensyms; +- travel_push_new(x); ++ travel_push(x); + dgs=0; + PRINTvs_limit = vs_top; +- travel_clear_new(x); ++ travel_clear(x); + END_NO_INTERRUPT; + + } + +-/* char travel_push_type[32]; */ +- +-/* static void */ +-/* travel_push_object(x) */ +-/* object x; */ +-/* { */ +-/* enum type t; */ +-/* int i; */ +-/* object *vp; */ +- +-/* cs_check(x); */ +- +-/* BEGIN: */ +-/* t = type_of(x); */ +-/* if(travel_push_type[(int)t]==0) return; */ +-/* if(t==t_symbol && x->s.s_hpack != Cnil) return; */ +- +-/* for (vp = PRINTvs_top; vp < vs_top; vp += 2) */ +-/* if (x == *vp) { */ +-/* if (vp[1] != Cnil) */ +-/* return; */ +-/* vp[1] = Ct; */ +-/* return; */ +-/* } */ +-/* vs_check_push(x); */ +-/* vs_check_push(Cnil); */ +-/* if (t == t_array && (enum aelttype)x->a.a_elttype == aet_object) */ +-/* for (i = 0; i < x->a.a_dim; i++) */ +-/* travel_push_object(x->a.a_self[i]); */ +-/* else if (t == t_vector && (enum aelttype)x->v.v_elttype == aet_object) */ +-/* for (i = 0; i < x->v.v_fillp; i++) */ +-/* travel_push_object(x->v.v_self[i]); */ +-/* else if (t == t_cons) { */ +-/* travel_push_object(x->c.c_car); */ +-/* x = x->c.c_cdr; */ +-/* goto BEGIN; */ +-/* } else if (t == t_structure) { */ +-/* for (i = 0; i < S_DATA(x->str.str_def)->length; i++) */ +-/* travel_push_object(structure_ref(x,x->str.str_def,i)); */ +-/* } */ +-/* } */ +- +-/* static void */ +-/* setupPRINTcircle(x,dogensyms) */ +-/* object x; */ +-/* int dogensyms; */ +-/* { object *vp,*vq; */ +-/* travel_push_type[(int)t_symbol]=dogensyms; */ +-/* travel_push_type[(int)t_array]= */ +-/* (travel_push_type[(int)t_vector]=PRINTarray); */ +-/* travel_push_object(x); */ +-/* for (vp = vq = PRINTvs_top; vp < vs_top; vp += 2) */ +-/* if (vp[1] != Cnil) { */ +-/* vq[0] = vp[0]; */ +-/* vq[1] = Cnil; */ +-/* vq += 2; */ +-/* } */ +-/* PRINTvs_limit = vs_top = vq; */ +-/* } */ +- + void + setupPRINTdefault(x) + object x; +@@ -1640,8 +1547,8 @@ object x; + vs_push(PRINTstream); + FEwrong_type_argument(sLstream, PRINTstream); + } +- PRINTescape = symbol_value(sLAprint_escapeA) != Cnil; + PRINTreadably = symbol_value(sLAprint_readablyA) != Cnil; ++ PRINTescape = PRINTreadably || symbol_value(sLAprint_escapeA) != Cnil; + PRINTpretty = symbol_value(sLAprint_prettyA) != Cnil; + PRINTcircle = symbol_value(sLAprint_circleA) != Cnil; + y = symbol_value(sLAprint_baseA); diff --git a/patches/list_order.12 b/patches/list_order.12 new file mode 100644 index 00000000..e5991588 --- /dev/null +++ b/patches/list_order.12 @@ -0,0 +1,50 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-55) unstable; urgency=medium + . + * disable gprof on aarch64 + * Bug fix: "gcl FTBFS on arm64: Unrecoverable error: Segmentation + violation..", thanks to Adrian Bunk (Closes: #873052). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/873052 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-08-24 + +--- gcl-2.6.12.orig/o/regexpr.c ++++ gcl-2.6.12/o/regexpr.c +@@ -66,6 +66,7 @@ DEFUN_NEW("COMPILE-REGEXP",object,fScomp + + char *tmp; + object res; ++ ufixnum i=0; + + if (type_of(p)!= t_string && type_of(p)!=t_symbol) + not_a_string_or_symbol(p); +@@ -82,9 +83,9 @@ DEFUN_NEW("COMPILE-REGEXP",object,fScomp + res->v.v_adjustable=0; + res->v.v_offset=0; + res->v.v_self=NULL; +- if (!(res->v.v_self=(void *)regcomp(tmp,&res->v.v_dim))) ++ if (!(res->v.v_self=(void *)regcomp(tmp,&i))) + FEerror("regcomp failure",0); +- res->v.v_fillp=res->v.v_dim; ++ res->v.v_fillp=res->v.v_dim=i; + + RETURN1(res); + diff --git a/patches/list_order.13 b/patches/list_order.13 new file mode 100644 index 00000000..3a95b63a --- /dev/null +++ b/patches/list_order.13 @@ -0,0 +1,36 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-57) unstable; urgency=medium + . + * list_order.13 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-08-29 + +--- gcl-2.6.12.orig/h/elf32_mips_reloc.h ++++ gcl-2.6.12/h/elf32_mips_reloc.h +@@ -35,7 +35,7 @@ + if (a) add_vals(where,MASK(16),(s>>16)+a); + break; + case R_MIPS_LO16: +- if (sym->st_other) s=gpd; ++ if (sym->st_other) s=gpd ? gpd : ({massert(sym->st_other==2);(ul)got;}); + a=*where&MASK(16); + if (a&0x8000) a|=0xffff0000; + a+=s&MASK(16); diff --git a/patches/list_order.16 b/patches/list_order.16 new file mode 100644 index 00000000..d4b69556 --- /dev/null +++ b/patches/list_order.16 @@ -0,0 +1,412 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-58) unstable; urgency=medium + . + * list_order.14 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-12 + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1964,3 +1964,9 @@ vsystem(const char *); + + object + n_cons_from_x(fixnum,object); ++ ++int ++seek_to_end_ofile(FILE *); ++ ++void ++travel_find_sharing(object,object); +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -976,100 +976,13 @@ fasd_patch_sharp(object x, int depth) + } + + object sharing_table; +-static enum circ_ind +-is_it_there(object x) +-{ struct htent *e; +- object table=sharing_table; +- switch(type_of(x)){ +- case t_cons: +- case t_symbol: +- case t_structure: +- case t_array: +- case t_vector: +- case t_package: +- e= gethash(x,table); +- if (e->hte_key ==OBJNULL) +- {sethash(x,table,make_fixnum(-1)); +- return FIRST_INDEX; +- } +- else +- {int n=fix(e->hte_value); +- if (n <0) +- e->hte_value=make_fixnum(n-1); +- return LATER_INDEX;} +- break; +- default: +- return NOT_INDEXED;}} + +- +- +-static void +-find_sharing(object x) +-{ +- cs_check(x); +- BEGIN: +- if(is_it_there(x)!=FIRST_INDEX) return; +- +- switch (type_of(x)) { +- +- case DP(t_cons:) +- +- find_sharing(x->c.c_car); +- x=x->c.c_cdr; +- goto BEGIN; +- +- break; +- +- case DP(t_vector:) +- { +- int i; +- +- if ((enum aelttype)x->v.v_elttype != aet_object) +- break; +- +- for (i = 0; i < x->v.v_fillp; i++) +- find_sharing(x->v.v_self[i]); +- break; +- } +- case DP(t_array:) +- { +- int i, j; +- +- if ((enum aelttype)x->a.a_elttype != aet_object) +- break; +- +- for (i = 0, j = 1; i < x->a.a_rank; i++) +- j *= x->a.a_dims[i]; +- for (i = 0; i < j; i++) +- find_sharing(x->a.a_self[i]); +- break; +- } +- case DP(t_structure:) +- {object def = x->str.str_def; +- int i; +- i=S_DATA(def)->length; +- while (i--> 0) +- find_sharing(structure_ref(x,def,i)); +- break; +- } +- default: +- break; +- } +- return; +-} +- +-DEFUN_NEW("FIND-SHARING-TOP",object,fSfind_sharing_top,SI,2,2,NONE,OO,OO,OO,OO,(object x, object table),"") +-/* static object */ +-/* FFN(find_sharing_top)(object x, object table) */ +-{sharing_table=table; +- find_sharing(x); +- return Ct; ++DEFUN_NEW("FIND-SHARING-TOP",object,fSfind_sharing_top,SI,2,2,NONE,OO,OO,OO,OO,(object x, object table),"") { ++ sharing_table=table; ++ travel_find_sharing(x,table); ++ return Ct; + } + +- +- +- +- + /* static object */ + /* read_fasd(int i) */ + /* {object tem; */ +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -490,7 +490,6 @@ int level; + void (*wf)(int) = write_ch_fun; + + object *vt = PRINTvs_top; +- object *vl = PRINTvs_limit; + bool e = PRINTescape; + bool ra = PRINTreadably; + bool r = PRINTradix; +@@ -599,7 +598,6 @@ L: + PRINTradix = r; + PRINTescape = e; + PRINTreadably = ra; +- PRINTvs_limit = vl; + PRINTvs_top = vt; + + write_ch_fun = wf; +@@ -702,18 +700,19 @@ print_symbol_name_body(object x) { + #define FOUND -1 + + static int +-do_write_sharp_eq(object x,bool dot) { ++do_write_sharp_eq(struct htent *e,bool dot) { + +- bool defined=x->c.c_cdr!=Cnil; ++ fixnum val=fix(e->hte_value); ++ bool defined=val&1; + + if (dot) { + write_str(" . "); + if (!defined) return FOUND; + } + +- x->c.c_cdr=Ct; ++ if (!defined) e->hte_value=make_fixnum(val|1); + write_ch('#'); +- write_decimal(fix(x->c.c_car)); ++ write_decimal(val>>1); + write_ch(defined ? '#' : '='); + + return defined ? DONE : FOUND; +@@ -726,7 +725,7 @@ write_sharp_eq(object x,bool dot) { + struct htent *e; + + return PRINTvs_top[0]!=Cnil && (e=gethash(x,PRINTvs_top[0]))->hte_key!=OBJNULL ? +- do_write_sharp_eq(e->hte_value,dot) : 0; ++ do_write_sharp_eq(e,dot) : 0; + + } + +@@ -1392,79 +1391,65 @@ int level; + } + } + +-static int dgs; ++static int dgs,dga; + + #include "page.h" + +-#define travel_seen(x) x->d.m +-#define travel_pushed(x) x->d.f +-#define travel_bits(x) x->md.mf +- + static void + travel_push(object x) { + + int i; + +- if (NULL_OR_ON_C_STACK(x)) ++ if (is_imm_fixnum(x)) + return; + +- if (travel_seen(x)) { ++ if (is_marked(x)) { + +- if (!travel_pushed(x)) { ++ if (imcdr(x) || !x->d.f) + vs_check_push(x); +- travel_pushed(x)=1; +- } +- +- return; ++ if (!imcdr(x)) ++ x->d.f=1; + +- } +- +- switch (type_of(x)) { ++ } else switch (type_of(x)) { + +- case t_symbol: ++ case t_symbol: + +- if (dgs && x->s.s_hpack==Cnil) +- travel_seen(x)=1; +- break; +- +- case t_cons: +- +- { +- object y=x->c.c_cdr; +- travel_seen(x)=1; +- travel_push(x->c.c_car); +- travel_push(y); +- } +- break; ++ if (dgs && x->s.s_hpack==Cnil) { ++ mark(x); ++ } ++ break; + +- case t_array: ++ case t_cons: + +- travel_seen(x)=1; +- if ((enum aelttype)x->a.a_elttype == aet_object) +- for (i=0;ia.a_dim;i++) +- travel_push(x->a.a_self[i]); +- break; ++ { ++ object y=x->c.c_cdr; ++ mark(x); ++ travel_push(x->c.c_car); ++ travel_push(y); ++ } ++ break; + +- case t_vector: ++ case t_vector: ++ case t_array: + +- travel_seen(x)=1; +- if ((enum aelttype)x->v.v_elttype == aet_object) +- for (i=0;iv.v_fillp;i++) +- travel_push(x->v.v_self[i]); +- break; ++ mark(x); ++ if (dga && (enum aelttype)x->a.a_elttype==aet_object) ++ for (i=0;ia.a_dim;i++) ++ travel_push(x->a.a_self[i]); ++ break; + +- case t_structure: ++ case t_structure: + +- travel_seen(x)=1; +- for (i = 0; i < S_DATA(x->str.str_def)->length; i++) +- travel_push(structure_ref(x,x->str.str_def,i)); +- break; ++ mark(x); ++ for (i = 0; i < S_DATA(x->str.str_def)->length; i++) ++ travel_push(structure_ref(x,x->str.str_def,i)); ++ break; + +- default: ++ default: + +- break; ++ break; + +- } ++ } + + } + +@@ -1474,10 +1459,15 @@ travel_clear(object x) { + + int i; + +- if (NULL_OR_ON_C_STACK(x) || !travel_bits(x)) ++ if (is_imm_fixnum(x)) ++ return; ++ ++ if (!is_marked(x)) + return; + +- travel_bits(x)=0; ++ unmark(x); ++ if (!imcdr(x)) ++ x->d.f=0; + + switch (type_of(x)) { + +@@ -1487,20 +1477,14 @@ travel_clear(object x) { + travel_clear(x->c.c_cdr); + break; + ++ case t_vector: + case t_array: + +- if ((enum aelttype)x->a.a_elttype == aet_object) ++ if (dga && (enum aelttype)x->a.a_elttype == aet_object) + for (i=0;ia.a_dim;i++) + travel_clear(x->a.a_self[i]); + break; + +- case t_vector: +- +- if ((enum aelttype)x->v.v_elttype == aet_object) +- for (i=0;iv.v_fillp;i++) +- travel_clear(x->v.v_self[i]); +- break; +- + case t_structure: + + for (i = 0; i < S_DATA(x->str.str_def)->length; i++) +@@ -1515,26 +1499,47 @@ travel_clear(object x) { + + } + +-object sLeq; +- + static void +-setupPRINTcircle(object x,int dogensyms) { +- +- object *xp; ++travel(object x,int mdgs,int mdga) { + + BEGIN_NO_INTERRUPT; +- dgs=dogensyms; ++ dgs=mdgs; ++ dga=mdga; + travel_push(x); +- dgs=0; +- PRINTvs_limit = vs_top; + travel_clear(x); + END_NO_INTERRUPT; + +- vs_check_push(PRINTvs_limit>PRINTvs_top ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil); +- for (xp=PRINTvs_top;xpvp ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil; ++ for (j=0;vhte_key==OBJNULL) ++ sethash(*v,h,make_fixnum((j++)<<1)); ++ ++ vs_top=vp; ++ vs_push(h); ++ ++} ++ ++void ++travel_find_sharing(object x,object table) { ++ ++ object *vp=vs_top; ++ ++ travel(x,1,1); ++ ++ for (;vs_top>vp;vs_top--) ++ sethash(vs_head,table,make_fixnum(-2)); + + } + diff --git a/patches/list_order.17 b/patches/list_order.17 new file mode 100644 index 00000000..02a38973 --- /dev/null +++ b/patches/list_order.17 @@ -0,0 +1,1136 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-59) unstable; urgency=medium + . + * list_order.16 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-23 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -98,7 +98,9 @@ + (defvar *default-c-file* nil) + (defvar *default-h-file* nil) + (defvar *default-data-file* nil) ++(defvar *default-prof-p* nil) + (defvar *keep-gaz* nil) ++(defvar *prof-p* nil) + + ;; (list section-length split-file-names next-section-start-file-position) + ;; Many c compilers cannot handle the large C files resulting from large lisp files. +@@ -167,10 +169,12 @@ + (data-file *default-data-file*) + (c-debug nil) + (system-p *default-system-p*) ++ (prof-p *default-prof-p*) + (print nil) + (load nil) + &aux (*standard-output* *standard-output*) +- (*error-output* *error-output*) ++ (*prof-p* prof-p) ++ (*error-output* *error-output*) + (*compiler-in-use* *compiler-in-use*) + (*c-debug* c-debug) + (*compile-print* (or print *compile-print*)) +@@ -488,8 +492,9 @@ Cannot compile ~a.~%" + (t (setq dir "."))) + (setq na (namestring + (make-pathname :name name :type (pathname-type(first args))))) +- (format nil "~a -I~a ~a ~a -c ~a -o ~a ~a" ++ (format nil "~a ~a -I~a ~a ~a -c ~a -o ~a ~a" + *cc* ++ (if *prof-p* " -pg " "") + (concatenate 'string si::*system-directory* "../h") + (if (and (boundp '*c-debug*) *c-debug*) " -g " "") + (case *speed* +--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp +@@ -124,6 +124,7 @@ + x)) + + (defun wt-data-file () ++ (when *prof-p* (add-init `(si::mark-memory-as-profiling))) + (verify-data-vector (data-vector)) + (let* ((vec (coerce (nreverse (data-inits)) 'vector))) + (verify-data-vector vec) +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4131,30 +4131,11 @@ $as_echo "disabled" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 + $as_echo "ok" >&6; } +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5 +-$as_echo_n "checking for text start... " >&6; } +- echo 'int main () {return(0);}' >foo.c +- $CC foo.c -o foo +- GCL_GPROF_START=`nm foo | $AWK '/ *[TD] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +- rm -f foo.c foo +- if test "$GCL_GPROF_START" != "" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCL_GPROF_START" >&5 +-$as_echo "$GCL_GPROF_START" >&6; } +- +-cat >>confdefs.h <<_ACEOF +-#define GCL_GPROF_START $GCL_GPROF_START +-_ACEOF +- +- assert_arg_to_cflags -pg +- case $use in +- s390*) ;; # relocation truncation bug in gcc +- *) TLIBS="$TLIBS -pg";; +- esac +- TFPFLAG="" ++ assert_arg_to_cflags -pg ++ TFPFLAG="" + + $as_echo "#define GCL_GPROF 1" >>confdefs.h + +- fi + fi + fi + fi +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -342,22 +342,25 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + AC_MSG_RESULT([disabled]) + else + AC_MSG_RESULT([ok]) +- AC_MSG_CHECKING([for text start]) +- echo 'int main () {return(0);}' >foo.c +- $CC foo.c -o foo +- GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +- rm -f foo.c foo +- if test "$GCL_GPROF_START" != "" ; then +- AC_MSG_RESULT($GCL_GPROF_START) +- AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) +- assert_arg_to_cflags -pg +- case $use in +- s390*) ;; # relocation truncation bug in gcc +- *) TLIBS="$TLIBS -pg";; +- esac +- TFPFLAG="" +- AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +- fi ++ assert_arg_to_cflags -pg ++ TFPFLAG="" ++ AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++dnl AC_MSG_CHECKING([for text start]) ++dnl echo 'int main () {return(0);}' >foo.c ++dnl $CC foo.c -o foo ++dnl GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++dnl rm -f foo.c foo ++dnl if test "$GCL_GPROF_START" != "" ; then ++dnl AC_MSG_RESULT($GCL_GPROF_START) ++dnl AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) ++dnl assert_arg_to_cflags -pg ++dnl # case $use in ++dnl # s390*) ;; # relocation truncation bug in gcc ++dnl # *) TLIBS="$TLIBS -pg";; ++dnl # esac ++dnl TFPFLAG="" ++dnl AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++dnl fi + fi + fi]) + +--- gcl-2.6.12.orig/h/gclincl.h.in ++++ gcl-2.6.12/h/gclincl.h.in +@@ -53,9 +53,6 @@ + /* use gprof profiling */ + #undef GCL_GPROF + +-/* starting address for gprof */ +-#undef GCL_GPROF_START +- + /* No gettimeofday call -- fixme */ + #undef GETTOD_NOT_DECLARED + +@@ -153,6 +150,9 @@ + /* use libbfd */ + #undef HAVE_LIBBFD + ++/* Define to 1 if you have the `dl' library (-ldl). */ ++#undef HAVE_LIBDL ++ + /* Define to 1 if you have the `opcodes' library (-lopcodes). */ + #undef HAVE_LIBOPCODES + +@@ -255,9 +255,6 @@ + /* using xgcl */ + #undef HAVE_XGCL + +-/* number of pages to use for hole */ +-#undef HOLEPAGE +- + /* Host cpu */ + #undef HOST_CPU + +@@ -267,9 +264,6 @@ + /* Host system */ + #undef HOST_SYSTEM + +-/* time system constant */ +-#undef HZ +- + /* invocation history stack size */ + #undef IHSSIZE + +@@ -321,7 +315,7 @@ + /* can use C extension for object alignment */ + #undef OBJ_ALIGN + +-/* needed object alignment in bytes */ ++/* needed object alignment bytes */ + #undef OBJ_ALIGNMENT + + /* Define to the address where bug reports for this package should be sent. */ +@@ -345,7 +339,7 @@ + /* system pagewidth */ + #undef PAGEWIDTH + +-/* have sigcontext in signal.h */ ++/* have sigcontext of signal.h */ + #undef SIGNAL_H_HAS_SIGCONTEXT + + /* sizeof linked list for contiguous pages */ +--- gcl-2.6.12.orig/h/lu.h ++++ gcl-2.6.12/h/lu.h +@@ -355,7 +355,8 @@ struct cfdata { + FIRSTWORD; + char *cfd_start; + int cfd_size; +- int cfd_fillp; ++ int cfd_fillp:31; ++ int cfd_prof:1; + object *cfd_self; + SPAD; + }; +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1788,10 +1788,8 @@ int sigprocmask ( int how, const sigset_ + void recreate_heap1 ( void ); + #endif + +-#ifdef GCL_GPROF + void + gprof_cleanup(void); +-#endif + + int + msystem(const char *); +@@ -1970,3 +1968,6 @@ seek_to_end_ofile(FILE *); + + void + travel_find_sharing(object,object); ++ ++object ++new_cfdata(void); +--- gcl-2.6.12.orig/h/ptable.h ++++ gcl-2.6.12/h/ptable.h +@@ -38,6 +38,8 @@ typedef struct node TABL[]; + struct string_address_table + { struct node *ptable; + unsigned int length; ++ struct node *local_ptable; ++ unsigned int local_length; + unsigned int alloc_length; + }; + +--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp ++++ gcl-2.6.12/lsp/gcl_mislib.lsp +@@ -165,3 +165,27 @@ + (push (string-concatenate s l) nl)) + (setq *load-path* nl)) + nil) ++ ++(defun default-symtab nil (concatenate 'string *tmp-dir* "gcl_symtab")) ++ ++(defun gprof-output (symtab gmon) ++ (with-open-file ++ (s (format nil "|gprof -S '~a' '~a' '~a'" symtab (kcl-self) gmon)) ++ (copy-stream s *standard-output*))) ++ ++ ++(defun gprof-start (&optional (start 0 start-p) (end 0 end-p) (symtab (default-symtab))) ++ (unless end-p ++ (multiple-value-bind ++ (s e) ++ (gprof-addresses) ++ (setq start (if start-p start s) end e))) ++ (when (monstartup start end) ++ (write-symtab symtab start end))) ++ ++(defun gprof-quit (&optional (symtab (default-symtab)) &aux (gmon (mcleanup))) ++ (when gmon ++ (gprof-output symtab gmon))) ++ ++ ++ +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -1177,24 +1177,6 @@ init_tm(enum type t, char *name, int els + call is too fragile. 20050115 CM*/ + static int gcl_alloc_initialized; + +- +-#ifdef GCL_GPROF +-static unsigned long textstart,textend,textpage; +-static void init_textpage() { +- +- extern void *GCL_GPROF_START; +- unsigned long s=(unsigned long)GCL_GPROF_START; +- +- textstart=(unsigned long)&GCL_GPROF_START; +- textend=(unsigned long)&etext; +- if (stextend || s>textstart)) +- textstart=s; +- +- textpage=2*(textend-textstart)/PAGESIZE; +- +-} +-#endif +- + object malloc_list=Cnil; + + #include +@@ -1220,10 +1202,6 @@ gcl_init_alloc(void *cs_start) { + init_darwin_zone_compat (); + #endif + +-#ifdef GCL_GPROF +- init_textpage(); +-#endif +- + #if defined(BSD) && defined(RLIMIT_STACK) + { + struct rlimit rl; +@@ -1301,11 +1279,6 @@ gcl_init_alloc(void *cs_start) { + initial_sbrk=data_start=heap_end; + first_data_page=page(data_start); + +-/* #ifdef GCL_GPROF */ +-/* if (new_holepage>PAGEWIDTH)); + } + +- +-#ifdef GCL_GPROF +- +-static unsigned long start,end,gprof_on; +-static void *initial_monstartup_pointer; +- +-void +-gprof_cleanup(void) { +- +- extern void _mcleanup(void); +- +- if (initial_monstartup_pointer) { +- _mcleanup(); +- gprof_on=0; +- } +- +- if (gprof_on) { +- +- char b[PATH_MAX],b1[PATH_MAX]; +- +- if (!getcwd(b,sizeof(b))) +- FEerror("Cannot get working directory", 0); +- if (chdir(P_tmpdir)) +- FEerror("Cannot change directory to tmpdir", 0); +- _mcleanup(); +- if (snprintf(b1,sizeof(b1),"gmon.out.%u",getpid())<=0) +- FEerror("Cannot write temporary gmon filename", 0); +- if (rename("gmon.out",b1)) +- FEerror("Cannot rename gmon.out",0); +- if (chdir(b)) +- FEerror("Cannot restore working directory", 0); +- gprof_on=0; +- +- } +- +-} +- +-static inline int +-my_monstartup(unsigned long start,unsigned long end) { +- +- extern void monstartup(unsigned long,unsigned long); +- +- monstartup(start,end); +- +- return 0; +- +-} +- +-DEFUN_NEW("GPROF-START",object,fSgprof_start,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { +- +- extern void *GCL_GPROF_START; +- static int n; +- +- if (!gprof_on) { +- start=start ? start : textstart; +- end=end ? end : textend; +- writable_malloc_wrap(my_monstartup,int,start,end); +- gprof_on=1; +- if (!n && atexit(gprof_cleanup)) { +- FEerror("Cannot setup gprof_cleanup on exit", 0); +- n=1; +- } +- } +- +- return Cnil; +- +-} +- +-DEFUN_NEW("GPROF-SET",object,fSgprof_set,SI +- ,2,2,NONE,OI,IO,OO,OO,(fixnum dstart,fixnum dend),"") +-{ +- +- start=dstart; +- end=dend; +- +- return Cnil; +- +-} +- +-DEFUN_NEW("GPROF-QUIT",object,fSgprof_quit,SI +- ,0,0,NONE,OO,OO,OO,OO,(void),"") +-{ +- extern void _mcleanup(void); +- char b[PATH_MAX],b1[PATH_MAX]; +- FILE *pp; +- unsigned n; +- +- if (!gprof_on) +- return Cnil; +- +- massert(getcwd(b,sizeof(b))); +- massert(!chdir(P_tmpdir)); +- _mcleanup(); +- massert(snprintf(b1,sizeof(b1),"gprof '%s'",kcl_self)>0); +- massert((pp=popen(b1,"r"))); +- while ((n=fread(b1,1,sizeof(b1),pp))) +- massert(fwrite(b1,1,n,stdout)); +- massert(pclose(pp)>=0); +- massert(!chdir(b)); +- gprof_on=0; +- +- return Cnil; +- +-} +- +-#endif +- + DEFUN_NEW("SET-STARTING-HOLE-DIVISOR",object,fSset_starting_hole_divisor,SI,1,1,NONE,II,OO,OO,OO,(fixnum div),"") { + if (div>0 && div <100) + starting_hole_div=div; +@@ -1808,20 +1670,7 @@ malloc_internal(size_t size) { + void * + malloc(size_t size) { + +- void *v=malloc_internal(size);; +- +- /* FIXME: this is just to handle clean freeing of the +- monstartup memory allocated automatically on raw image +- startup. In saved images, monstartup memory is only +- allocated with gprof-start. 20040804 CM*/ +-#ifdef GCL_GPROF +- if (raw_image && size>(textend-textstart) && !initial_monstartup_pointer) { +- massert(!atexit(gprof_cleanup)); +- initial_monstartup_pointer=v; +- } +-#endif +- +- return v; ++ return malloc_internal(size); + + } + +@@ -1830,7 +1679,6 @@ void + free(void *ptr) { + + object *p,pp; +- static void *initial_monstartup_pointer_echo; + + if (ptr == 0) + return; +@@ -1839,15 +1687,9 @@ free(void *ptr) { + if ((pp)->c.c_car->st.st_self == ptr) { + (pp)->c.c_car->st.st_self = NULL; + *p = pp->c.c_cdr; +-#ifdef GCL_GPROF +- if (initial_monstartup_pointer==ptr) { +- initial_monstartup_pointer_echo=ptr; +- initial_monstartup_pointer=NULL; +- } +-#endif + return; + } +- if (ptr!=initial_monstartup_pointer_echo) { ++ { + static void *old_ptr; + if (old_ptr==ptr) return; + old_ptr=ptr; +@@ -1855,7 +1697,6 @@ free(void *ptr) { + FEerror("free(3) error.",0); + #endif + } +- initial_monstartup_pointer_echo=NULL; + return; + } + +--- gcl-2.6.12.orig/o/cmpaux.c ++++ gcl-2.6.12/o/cmpaux.c +@@ -393,6 +393,15 @@ call_init(int init_address, object memor + + */ + ++DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0, ++ NONE,OO,OO,OO,OO,(void),"") { ++ ++ sSPmemory->s.s_dbind->cfd.cfd_prof=1; ++ ++ return Cnil; ++ ++} ++ + void + do_init(object *statVV) + {object fasl_vec=sSPinit->s.s_dbind; +@@ -467,6 +476,22 @@ char *s; + + #endif + ++object ++new_cfdata(void) { ++ ++ object memory=alloc_object(t_cfdata); ++ ++ memory->cfd.cfd_size=0; ++ memory->cfd.cfd_fillp=0; ++ memory->cfd.cfd_prof=0; ++ memory->cfd.cfd_self=0; ++ memory->cfd.cfd_start=0; ++ ++ return memory; ++ ++} ++ ++ + void + gcl_init_or_load1(void (*fn)(void),const char *file) { + +@@ -476,10 +501,7 @@ gcl_init_or_load1(void (*fn)(void),const + object fasl_data; + file=FIX_PATH_STRING(file); + +- memory=alloc_object(t_cfdata); +- memory->cfd.cfd_self=0; +- memory->cfd.cfd_fillp=0; +- memory->cfd.cfd_size = 0; ++ memory=new_cfdata(); + memory->cfd.cfd_start= (char *)fn; + printf("Initializing %s\n",file); fflush(stdout); + fasl_data = read_fasl_data(file); +--- gcl-2.6.12.orig/o/fasldlsym.c ++++ gcl-2.6.12/o/fasldlsym.c +@@ -101,10 +101,7 @@ fasload(object faslfile) { + SEEK_TO_END_OFILE(faslstream->sm.sm_fp); + + data = read_fasl_vector(faslstream); +- memory = alloc_object(t_cfdata); +- memory->cfd.cfd_self = NULL; +- memory->cfd.cfd_start = NULL; +- memory->cfd.cfd_size = 0; ++ memory=new_cfdata(); + + if(symbol_value(sLAload_verboseA)!=Cnil) + printf(" start address (dynamic) %p ",fptr); +--- /dev/null ++++ gcl-2.6.12/o/gprof.c +@@ -0,0 +1,137 @@ ++#include "include.h" ++#include "page.h" ++#include "ptable.h" ++ ++ ++static unsigned long gprof_on; ++ ++DEFUN_NEW("MCLEANUP",object,fSmcleanup,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++ ++ extern void _mcleanup(void); ++ ++ if (!gprof_on) ++ return Cnil; ++ ++ massert(getcwd(FN1,sizeof(FN1))); ++ massert(!chdir(P_tmpdir)); ++ _mcleanup(); ++ massert(!chdir(FN1)); ++ gprof_on=0; ++ massert(snprintf(FN1,sizeof(FN1),"%s/gmon.out",P_tmpdir)>0); ++ return make_simple_string(FN1); ++} ++ ++static inline int ++my_monstartup(unsigned long start,unsigned long end) { ++ ++ extern void monstartup(unsigned long,unsigned long); ++ ++ monstartup(start,end); ++ ++ return 0; ++ ++} ++ ++DEFUN_NEW("MONSTARTUP",object,fSmonstartup,SI,2,2,NONE,OI,IO,OO,OO,(ufixnum start,ufixnum end),"") { ++ ++ if (gprof_on) ++ return Cnil; ++ ++ writable_malloc_wrap(my_monstartup,int,start,end); ++ gprof_on=1; ++ ++ return Ct; ++ ++} ++ ++void ++gprof_cleanup(void) { ++ ++ FFN(fSmcleanup)(); ++ /*rename gmon?*/ ++ ++} ++ ++DEFUNM_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++ ++ void *min=heap_end,*max=data_start,*c; ++ static void *mintext; ++ struct pageinfo *v; ++ object x; ++ fixnum i; ++ struct typemanager *tm=tm_of(t_cfdata); ++ ++ for (v=cell_list_head;v;v=v->next) ++ if (v->type==tm->tm_type) ++ for (c=pagetochar(page(v)),i=0;itm_nppage;i++,c+=tm->tm_size) ++ if (!is_free((x=c)) && type_of(x)==t_cfdata && x->cfd.cfd_prof) { ++ min=(void *)x->cfd.cfd_startcfd.cfd_start : min; ++ max=(void *)x->cfd.cfd_start+x->cfd.cfd_size>max ? x->cfd.cfd_start+x->cfd.cfd_size : max; ++ } ++ ++ if (maxp_link) ++ for (i=0,b=p->p_internal,be=b+p->p_internal_size;b; ++ b=i ? NULL : p->p_external,be=b+p->p_external_size,i=1) ++ for (;bc.c_cdr) ++ if ((f=(s=l->c.c_car)->s.s_gfdef)!=OBJNULL && s->s.s_hpack==(object)p) ++ switch(type_of(f)) { ++ case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun: ++ if ((ufixnum)f->cf.cf_self>=start && (ufixnum)f->cf.cf_selfcf.cf_self, ++ p->p_name->st.st_fillp,p->p_name->st.st_self, ++ s->st.st_fillp,s->st.st_self); ++ break; ++ } ++ fprintf(pp,"%016lx T GCL_MONEND\n",end); ++ ++ for (i=0;icfd.cfd_self = 0; +- memory->cfd.cfd_start = 0; +- memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss; +- vs_push(memory); +- the_start=start_address= +- memory->cfd.cfd_start = +- alloc_contblock(memory->cfd.cfd_size); +- sfaslp->s_start_data = start_address + textsize; +- sfaslp->s_start_bss = start_address + textsize + datasize; +- END_NO_INTERRUPT; ++ memory=new_cfdata(); ++ memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss; ++ vs_push(memory); ++ the_start=start_address= ++ memory->cfd.cfd_start= ++ alloc_contblock(memory->cfd.cfd_size); ++ sfaslp->s_start_data = start_address + textsize; ++ sfaslp->s_start_bss = start_address + textsize + datasize; ++ END_NO_INTERRUPT; + } + #else + the_start = start_address +--- gcl-2.6.12.orig/o/sfaslbfd.c ++++ gcl-2.6.12/o/sfaslbfd.c +@@ -269,9 +269,7 @@ fasload(object faslfile) { + curr_size=(unsigned long)current; + max_align=1<cfd.cfd_self = 0; +- memory->cfd.cfd_start = 0; ++ memory=new_cfdata(); + memory->cfd.cfd_size = curr_size + (max_align > sizeof(char *) ? max_align :0); + + memory->cfd.cfd_start=alloc_contblock(memory->cfd.cfd_size); +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -207,10 +207,8 @@ load_memory(struct scnhdr *sec1,struct s + if (ALLOC_SEC(sec)) + sec->s_paddr=sz; + +- memory = alloc_object(t_cfdata); ++ memory=new_cfdata(); + memory->cfd.cfd_size=sz; +- memory->cfd.cfd_self=0; +- memory->cfd.cfd_start=0; + memory->cfd.cfd_start=alloc_code_space(sz); + + for (sec=sec1;secn_sclass!=2 || sym->n_scnum<1) ++ if (sym->n_sclass<2 || sym->n_sclass>3 || sym->n_scnum<1) + continue; + + ns++; +@@ -270,7 +268,7 @@ load_self_symbols() { + + } + +- c_table.alloc_length=c_table.length=ns; ++ c_table.alloc_length=ns; + assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); + assert(st=malloc(sl)); + +@@ -296,9 +294,36 @@ load_self_symbols() { + sym+=sym->n_numaux; + + } +- ++ c_table.length=a-c_table.ptable; + qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); + ++ for (c_table.local_ptable=a,sym=sy1;symn_sclass!=3 || sym->n_scnum<1) ++ continue; ++ ++ NM(sym,st1,s,strcpy(st,s)); ++ ++ sec=sec1+sym->n_scnum-1; ++ jj=sym->n_value+sec->s_vaddr+h->h_ibase; ++ ++#ifdef FIX_ADDRESS ++ FIX_ADDRESS(jj); ++#endif ++ ++ a->address=jj; ++ a->string=st; ++ ++ a++; ++ st+=strlen(st)+1; ++ sym+=sym->n_numaux; ++ ++ } ++ c_table.local_length=a-c_table.local_ptable; ++ qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare); ++ ++ massert(c_table.alloc_length==c_table.length+c_table.local_length); ++ + massert(!un_mmap(v1,ve)); + massert(!fclose(f)); + +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -55,9 +55,12 @@ License for more details. + #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) + #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) + #define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) +-#define LOAD_SYM_BY_BIND(sym) ({ul _b=ELF_ST_BIND(sym->st_info); sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) +-#define LOAD_SYM_BY_NAME(sym,st1) 0 +-#define LOAD_SYM(sym,st1) (LOAD_SYM_BY_BIND(sym)||LOAD_SYM_BY_NAME(sym,st1)) ++#define EXT_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info); \ ++ sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) ++#define LOCAL_SYM(sym) (sym->st_value && \ ++ ELF_ST_BIND(sym->st_info)==STB_LOCAL) ++ /* && ELF_ST_TYPE(sym->st_info)==STT_FUNC) */ ++#define LOAD_SYM(sym) (EXT_SYM(sym)||LOCAL_SYM(sym)) + + #define MASK(n) (~(~0ULL << (n))) + +@@ -271,10 +274,8 @@ load_memory(Shdr *sec1,Shdr *sece,void * + sz+=gsz; + } + +- memory=alloc_object(t_cfdata); ++ memory=new_cfdata(); + memory->cfd.cfd_size=sz; +- memory->cfd.cfd_self=0; +- memory->cfd.cfd_start=0; + memory->cfd.cfd_start=alloc_code_space(sz); + + a=(ul)memory->cfd.cfd_start; +@@ -411,7 +412,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym * + + for (sym=sym1;symcfd.cfd_size=sz; +- memory->cfd.cfd_self=0; +- memory->cfd.cfd_start=0; + memory->cfd.cfd_start=alloc_code_space(sz); + + a=(ul)memory->cfd.cfd_start; +@@ -411,23 +409,19 @@ load_self_symbols() { + + if (sym->n_type & N_STAB) + continue; +- if (!(sym->n_type & N_EXT)) +- continue; + + ns++; + sl+=strlen(sym->n_un.n_strx+strtab)+1; + + } + +- c_table.alloc_length=c_table.length=ns; ++ c_table.alloc_length=ns; + assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length)); + assert(s=malloc(sl)); + + for (a=c_table.ptable,sym=sym1;symn_type & N_STAB) +- continue; +- if (!(sym->n_type & N_EXT)) ++ if (sym->n_type & N_STAB || !(sym->n_type & N_EXT)) + continue; + + a->address=sym->n_value; +@@ -438,9 +432,28 @@ load_self_symbols() { + s+=strlen(s)+1; + + } +- ++ c_table.length=a-c_table.ptable; + qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare); + ++ c_table.local_ptable=a; ++ for (a=c_table.ptable,sym=sym1;symn_type & N_STAB || sym->n_type & N_EXT) ++ continue; ++ ++ a->address=sym->n_value; ++ a->string=s; ++ strcpy(s,sym->n_un.n_strx+strtab); ++ ++ a++; ++ s+=strlen(s)+1; ++ ++ } ++ c_table.local_length=a-c_table.local_ptable; ++ qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare); ++ ++ massert(c_table.alloc_length==c_table.length+c_table.local_length); ++ + massert(!un_mmap(addr,addre)); + massert(!fclose(f)); + +--- gcl-2.6.12.orig/o/sfaslmacosx.c ++++ gcl-2.6.12/o/sfaslmacosx.c +@@ -232,10 +232,7 @@ int fasload (object faslfile) + + close_stream (faslstream); + +- memory = alloc_object (t_cfdata); +- memory->cfd.cfd_self = NULL; +- memory->cfd.cfd_start = NULL; +- memory->cfd.cfd_size = 0; ++ memory=new_cfdata(); + + if (symbol_value (sLAload_verboseA) != Cnil) + printf (" start address (dynamic) %p ", fptr); +--- gcl-2.6.12.orig/o/unixfasl.c ++++ gcl-2.6.12/o/unixfasl.c +@@ -146,9 +146,7 @@ object faslfile; + fread(&header, sizeof(header), 1, fp); + #endif + +- memory = alloc_object(t_cfdata); +- memory->cfd.cfd_self = NULL; +- memory->cfd.cfd_start = NULL; ++ memory=new_cfdata(); + memory->cfd.cfd_size = textsize + datasize + bsssize; + vs_push(memory); + /* If the file is smaller than the space asked for, typically the file +@@ -314,12 +312,10 @@ DEFUN_NEW("FASLINK-INT",object,fSfaslink + setbuf(fp, buf); + fread(&header, sizeof(header), 1, fp); + {BEGIN_NO_INTERRUPT; +- memory = alloc_object(t_cfdata); +- memory->cfd.cfd_self=0; +- memory->cfd.cfd_start = NULL; +- memory->cfd.cfd_size = textsize + datasize + bsssize; +- vs_push(memory); +- memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, ++ memory=new_cfdata(); ++ memory->cfd.cfd_size = textsize + datasize + bsssize; ++ vs_push(memory); ++ memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock, + memory->cfd.cfd_size, + sizeof(double)); + END_NO_INTERRUPT;} +--- gcl-2.6.12.orig/unixport/makefile ++++ gcl-2.6.12/unixport/makefile +@@ -69,28 +69,26 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l + [ "$(RL_OBJS)" = "" ] || \ + echo "(AUTOLOAD 'init-readline '|readline|)" >>$@ + +-sys_init.lsp: sys_init.lsp.in ++saved_%:raw_% $(RSYM) sys_init.lsp.in raw_%_map msys \ ++ $(CMPDIR)/gcl_cmpmain.lsp \ ++ $(CMPDIR)/gcl_lfun_list.lsp \ ++ $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ ++ $(LSPDIR)/gcl_auto_new.lsp + +- cat $< | sed \ ++ cat sys_init.lsp.in | sed \ + -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `cat ../release`#1" \ + -e "s#@LI-EXTVERS@#`cat ../minvers | cut -f2 -d.`#1" \ + -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ + -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ + -e "s#@LI-RELEASE@#`cat ../release`#1" \ +- -e "s#@LI-CC@#\"$(GCL_CC) -c $(FINAL_CFLAGS)\"#1" \ ++ -e "s#@LI-CC@#\"$(GCL_CC) -c $(filter-out -pg,$(FINAL_CFLAGS))\"#1" \ ++ -e "s#@LI-DFP@#\"$(filter -pg,$(FINAL_CFLAGS))\"#1" \ + -e "s#@LI-LD@#\"$(GCL_CC) $(LD_FLAGS) -o \"#1" \ +- -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ ++ -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_POST)\"#1" \ + -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ + -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ +- -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@ +- +-saved_%:raw_% $(RSYM) sys_init.lsp raw_%_map msys \ +- $(CMPDIR)/gcl_cmpmain.lsp \ +- $(CMPDIR)/gcl_lfun_list.lsp \ +- $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ +- $(LSPDIR)/gcl_auto_new.lsp ++ -e "s#@LI-INIT-LSP@#\"$@\"#1" >foo + +- cp sys_init.lsp foo + echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo + j=$$(ar t lib$*.a |grep ^gcl_);[ "$$j" = "" ] || ar x lib$*.a $$j #accelerator + $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo +@@ -160,7 +158,7 @@ map_%: + clean: + rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \ + $(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \ +- gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script sys_init.lsp ++ gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script + + .INTERMEDIATE: init_ansi_gcl.lsp.tmp init_gcl.lsp.tmp raw_gcl raw_ansi_gcl + .PRECIOUS: init_pre_gcl.lsp init_gcl.lsp init_ansi_gcl.lsp +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -59,8 +59,10 @@ + + (in-package :compiler) + (setq *cc* @LI-CC@ ++ *default-prof-p* (> (length @LI-DFP@) 0) + *ld* @LI-LD@ + *ld-libs* @LI-LD-LIBS@ ++ *ld-libs* (concatenate 'string "-l" #+ansi-cl "ansi_" "gcl " *ld-libs*) + *opt-three* @LI-OPT-THREE@ + *opt-two* @LI-OPT-TWO@ + *init-lsp* @LI-INIT-LSP@) diff --git a/patches/list_order.18 b/patches/list_order.18 new file mode 100644 index 00000000..8528b67b --- /dev/null +++ b/patches/list_order.18 @@ -0,0 +1,60 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-60) unstable; urgency=medium + . + * list_order.17 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-23 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -483,6 +483,12 @@ Cannot compile ~a.~%" + + (defvar *use-buggy* nil) + ++(defun remove-flag (flag flags) ++ (let ((i (search flag flags))) ++ (if i ++ (concatenate 'string (subseq flags 0 i) (remove-flag flag (subseq flags (+ i (length flag))))) ++ flags))) ++ + (defun compiler-command (&rest args &aux na ) + (declare (special *c-debug*)) + (let ((dirlist (pathname-directory (first args))) +@@ -493,7 +499,7 @@ Cannot compile ~a.~%" + (setq na (namestring + (make-pathname :name name :type (pathname-type(first args))))) + (format nil "~a ~a -I~a ~a ~a -c ~a -o ~a ~a" +- *cc* ++ (if *prof-p* (remove-flag "-fomit-frame-pointer" *cc*) *cc*) + (if *prof-p* " -pg " "") + (concatenate 'string si::*system-directory* "../h") + (if (and (boundp '*c-debug*) *c-debug*) " -g " "") +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -34,7 +34,7 @@ boot.o: boot.c $(DECL) boot.h + $(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) + + gprof.o: gprof.c $(DECL) +- $(CC) -c $(CFLAGS) $(DEFS) -pg $*.c $(AUX_INFO) ++ $(CC) -c $(filter-out -fomit-frame-pointer,$(CFLAGS)) $(DEFS) -pg $*.c $(AUX_INFO) + + prelink.o: prelink.c $(DECL) + $(CC) -c $(filter-out -pg,$(CFLAGS)) -fPIE $(DEFS) $*.c $(AUX_INFO) diff --git a/patches/list_order.19 b/patches/list_order.19 new file mode 100644 index 00000000..2c82b592 --- /dev/null +++ b/patches/list_order.19 @@ -0,0 +1,218 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-60) unstable; urgency=medium + . + * list_order.18 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-24 + +--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp ++++ gcl-2.6.12/lsp/gcl_mislib.lsp +@@ -166,24 +166,45 @@ + (setq *load-path* nl)) + nil) + +-(defun default-symtab nil (concatenate 'string *tmp-dir* "gcl_symtab")) +- + (defun gprof-output (symtab gmon) + (with-open-file + (s (format nil "|gprof -S '~a' '~a' '~a'" symtab (kcl-self) gmon)) + (copy-stream s *standard-output*))) + ++(defun write-symtab (symtab start end &aux (*package* (find-package "KEYWORD"))) ++ ++ (with-open-file ++ (s symtab :direction :output :if-exists :supersede) ++ ++ (format s "~16,'0x T ~a~%" start "GCL_MONSTART") + +-(defun gprof-start (&optional (start 0 start-p) (end 0 end-p) (symtab (default-symtab))) +- (unless end-p +- (multiple-value-bind +- (s e) +- (gprof-addresses) +- (setq start (if start-p start s) end e))) +- (when (monstartup start end) +- (write-symtab symtab start end))) ++ (dolist (p (list-all-packages)) ++ (do-symbols (x p) ++ (when (and (eq (symbol-package x) p) (fboundp x)) ++ (let* ((y (symbol-function x)) ++ (y (if (and (consp y) (eq 'macro (car y))) (cdr y) y)) ++ (y (if (compiled-function-p y) (function-start y) 0))) ++ (when (<= start y end) ++ (format s "~16,'0x T ~s~%" y x)))))) ++ ++ (let ((string-register "")) ++ (dotimes (i (ptable-alloc-length)) ++ (multiple-value-bind ++ (x y) (ptable i string-register) ++ (when (<= start x end) ++ (format s "~16,'0x T ~a~%" x y))))) ++ ++ (format s "~16,'0x T ~a~%" end "GCL_MONEND")) ++ ++ symtab) ++ ++(defun gprof-start (&optional (symtab "gcl_symtab") (adrs (gprof-addresses)) ++ &aux (start (car adrs))(end (cdr adrs))) ++ (let ((symtab (write-symtab symtab start end))) ++ (when (monstartup start end) ++ symtab))) + +-(defun gprof-quit (&optional (symtab (default-symtab)) &aux (gmon (mcleanup))) ++(defun gprof-quit (&optional (symtab "gcl_symtab") &aux (gmon (mcleanup))) + (when gmon + (gprof-output symtab gmon))) + +--- gcl-2.6.12.orig/o/fat_string.c ++++ gcl-2.6.12/o/fat_string.c +@@ -59,17 +59,16 @@ DEFUN_NEW("PROFILE",object,fSprofile,SI + } + + #endif +-DEFUN_NEW("FUNCTION-START",object,fSfunction_start,SI +- ,1,1,NONE,OO,OO,OO,OO,(object funobj),"") +-{/* 1 args */ +- if(type_of(funobj)!=t_cfun +- && type_of(funobj)!=t_sfun +- && type_of(funobj)!=t_vfun +- && type_of(funobj)!=t_afun +- && type_of(funobj)!=t_gfun) +- FEerror("not compiled function",0); +- funobj=make_fixnum((long) (funobj->cf.cf_self)); +- RETURN1(funobj); ++DEFUN_NEW("FUNCTION-START",object,fSfunction_start,SI,1,1,NONE,OO,OO,OO,OO,(object funobj),"") { ++ ++ switch (type_of(funobj)) { ++ case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun:case t_closure:case t_cclosure: ++ return make_fixnum((long) (funobj->cf.cf_self)); ++ default: ++ TYPE_ERROR(funobj,sLcompiled_function); ++ return Cnil; ++ } ++ + } + + /* begin fasl stuff*/ +--- gcl-2.6.12.orig/o/gprof.c ++++ gcl-2.6.12/o/gprof.c +@@ -12,13 +12,11 @@ DEFUN_NEW("MCLEANUP",object,fSmcleanup,S + if (!gprof_on) + return Cnil; + +- massert(getcwd(FN1,sizeof(FN1))); +- massert(!chdir(P_tmpdir)); +- _mcleanup(); +- massert(!chdir(FN1)); ++ massert((_mcleanup(),1)); + gprof_on=0; +- massert(snprintf(FN1,sizeof(FN1),"%s/gmon.out",P_tmpdir)>0); +- return make_simple_string(FN1); ++ ++ return make_simple_string("gmon.out"); ++ + } + + static inline int +@@ -48,11 +46,10 @@ void + gprof_cleanup(void) { + + FFN(fSmcleanup)(); +- /*rename gmon?*/ + + } + +-DEFUNM_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++DEFUN_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { + + void *min=heap_end,*max=data_start,*c; + static void *mintext; +@@ -77,10 +74,8 @@ DEFUNM_NEW("GPROF-ADDRESSES",object,fSgp + mintext=data_start; + + #ifdef GCL_GPROF +- for (i=0;ip_link) +- for (i=0,b=p->p_internal,be=b+p->p_internal_size;b; +- b=i ? NULL : p->p_external,be=b+p->p_external_size,i=1) +- for (;bc.c_cdr) +- if ((f=(s=l->c.c_car)->s.s_gfdef)!=OBJNULL && s->s.s_hpack==(object)p) +- switch(type_of(f)) { +- case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun: +- if ((ufixnum)f->cf.cf_self>=start && (ufixnum)f->cf.cf_selfcf.cf_self, +- p->p_name->st.st_fillp,p->p_name->st.st_self, +- s->st.st_fillp,s->st.st_self); +- break; +- } +- fprintf(pp,"%016lx T GCL_MONEND\n",end); +- +- for (i=0;ist.st_self=(void *)c_table.ptable[i].string; ++ s->st.st_fillp=s->st.st_dim=strlen(s->st.st_self); ++ RETURN2(make_fixnum(c_table.ptable[i].address),s); + } diff --git a/patches/list_order.20 b/patches/list_order.20 new file mode 100644 index 00000000..7e87bf07 --- /dev/null +++ b/patches/list_order.20 @@ -0,0 +1,72 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-60) unstable; urgency=medium + . + * list_order.19 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-30 + +--- gcl-2.6.12.orig/h/elf64_ppcle_reloc_special.h ++++ gcl-2.6.12/h/elf64_ppcle_reloc_special.h +@@ -16,7 +16,7 @@ find_special_params(void *v,Shdr *sec1,S + Rela *r; + void *ve; + +- massert((sec=get_section(".rela.plt",sec1,sece,sn))); ++ massert((sec=get_section(".rela.dyn",sec1,sece,sn))); + + v+=sec->sh_offset; + ve=v+sec->sh_size; +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -401,9 +401,9 @@ char *tmp_alloc; + */ + + #define ALLOC_ALIGNED(f, size,align) \ +- (align <= sizeof(plong) ? (char *)((f)(size)) : \ +- (tmp_alloc = (char *)((f)(size+(size ?(align)-1 : 0)))+(align)-1 , \ +- (char *)(align * (((unsigned long)tmp_alloc)/align)))) ++ ({ufixnum _size=size,_align=align;_align <= sizeof(plong) ? (char *)((f)(_size)) : \ ++ (tmp_alloc = (char *)((f)(_size+(_size ?(_align)-1 : 0)))+(_align)-1 , \ ++ (char *)(_align * (((unsigned long)tmp_alloc)/_align)));}) + #define AR_ALLOC(f,n,type) (type *) \ + (ALLOC_ALIGNED(f,(n)*sizeof(type),sizeof(type))) + +--- gcl-2.6.12.orig/o/fat_string.c ++++ gcl-2.6.12/o/fat_string.c +@@ -47,13 +47,17 @@ DEFUN_NEW("PROFILE",object,fSprofile,SI + + object ar=sSAprofile_arrayA->s.s_dbind; + void *x; ++ fixnum a,s; + + if (type_of(ar)!=t_string) + FEerror("si:*Profile-array* not a string",0); + if( type_of(start_address)!=t_fixnum || type_of(scale)!=t_fixnum) + FEerror("Needs start address and scale as args",0); + +- x=!(fix(start_address)*fix(scale)) ? NULL : (void *) (ar->ust.ust_self); ++ massert((a=fix(start_address))>=0); ++ massert((s=fix(scale))>=0); ++ ++ x=a&&s ? (void *) (ar->ust.ust_self) : NULL; + profil(x, (ar->ust.ust_dim),fix(start_address),fix(scale) << 8); + RETURN1(start_address); + } diff --git a/patches/list_order.21 b/patches/list_order.21 new file mode 100644 index 00000000..a8fc1531 --- /dev/null +++ b/patches/list_order.21 @@ -0,0 +1,48 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-61) unstable; urgency=medium + . + * list_order.20 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-01-30 + +--- gcl-2.6.12.orig/h/alpha-linux.h ++++ gcl-2.6.12/h/alpha-linux.h +@@ -5,12 +5,14 @@ + + #undef MPROTECT_ACTION_FLAGS + #define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO +-#ifdef IN_GBC +-#include +-#define GET_FAULT_ADDR(sig,code,scp,addr) \ +- (char *)((struct ucontext *)scp )->uc_mcontext.sc_traparg_a0 +-#endif +-#define SGC ++/* #ifdef IN_GBC */ ++/* #include */ ++/* #define GET_FAULT_ADDR(sig,code,scp,addr) \ no longer working*/ ++/* (char *)((struct ucontext *)scp )->uc_mcontext.sc_traparg_a0 */ ++/*#define GET_FAULT_ADDR(sig,code,sv,a) ((siginfo_t *)code)->si_addr perhaps try this when get access*/ ++/* #endif */ ++/* #define SGC */ ++#undef SGC + + #define RELOC_H "elf64_alpha_reloc.h" + #define SPECIAL_RELOC_H "elf64_alpha_reloc_special.h" diff --git a/patches/list_order.22 b/patches/list_order.22 new file mode 100644 index 00000000..26481812 --- /dev/null +++ b/patches/list_order.22 @@ -0,0 +1,62 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-61) unstable; urgency=medium + . + * list_order.21 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-02-01 + +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -55,12 +55,10 @@ License for more details. + #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;}) + #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS)) + #define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC && sec->sh_type==SHT_PROGBITS) +-#define EXT_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info); \ +- sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);}) +-#define LOCAL_SYM(sym) (sym->st_value && \ +- ELF_ST_BIND(sym->st_info)==STB_LOCAL) +- /* && ELF_ST_TYPE(sym->st_info)==STT_FUNC) */ +-#define LOAD_SYM(sym) (EXT_SYM(sym)||LOCAL_SYM(sym)) ++#define LOAD_SYM(sym,st1) (sym->st_value && (EXT_SYM(sym,st1)||LOCAL_SYM(sym))) ++#define EXT_SYM(sym,st1) (ELF_ST_BIND(sym->st_info)==STB_GLOBAL||ELF_ST_BIND(sym->st_info)==STB_WEAK||LOAD_SYM_BY_NAME(sym,st1)) ++#define LOCAL_SYM(sym) ELF_ST_BIND(sym->st_info)==STB_LOCAL ++#define LOAD_SYM_BY_NAME(sym,st1) 0 + + #define MASK(n) (~(~0ULL << (n))) + +@@ -412,7 +410,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym * + + for (sym=sym1;sym + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-62) unstable; urgency=medium + . + * list_order.22 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-02-01 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -658,7 +658,7 @@ Cannot compile ~a.~%" + (defun make-user-init (files outn) + + (let* ((c (pathname outn)) +- (c (merge-pathnames c (make-pathname :directory '(:current)))) ++ (c (merge-pathnames c (make-pathname :directory '(:relative)))) + (o (merge-pathnames (make-pathname :type "o") c)) + (c (merge-pathnames (make-pathname :type "c") c))) + +@@ -769,7 +769,7 @@ Cannot compile ~a.~%" + + (with-open-file (st (namestring map) :direction :output)) + (safe-system +- (let* ((par (namestring (make-pathname :directory '(:back)))) ++ (let* ((par (namestring (make-pathname :directory '(:relative :back)))) + (i (concatenate 'string " " par)) + (j (concatenate 'string " " si::*system-directory* par))) + (format nil "~a ~a ~a ~a -L~a ~a ~a ~a" +--- gcl-2.6.12.orig/gcl-tk/makefile ++++ gcl-2.6.12/gcl-tk/makefile +@@ -38,13 +38,13 @@ clean:: + rm -f ${GUIOS} $(OFILES) gcltkaux gcltksrv *.o */*.o demos/index.lsp *.fn demos/*.fn + + .c.o: +- $(GCLTKCC) -c $(CFLAGS1) ${ODIR_DEBUG} $*.c ++ $(GCLTKCC) -c $(filter-out -pg,$(CFLAGS1)) -fPIE ${ODIR_DEBUG} $*.c + + + # for some reason -lieee is on various linux systems in the list of requireds.. + + gcltkaux: $(GUIOS) +- $(LD_ORDINARY_CC) $(GUIOS) $(LDFLAGS) -o gcltkaux ${TK_LIB_SPEC} ${TCL_LIB_SPEC} ++ $(LD_ORDINARY_CC) $(GUIOS) $(filter-out %gcl.script,$(LDFLAGS)) -pie -o gcltkaux ${TK_LIB_SPEC} ${TCL_LIB_SPEC} + + gcltksrv: makefile + cat gcltksrv.in | sed -e "s!TK_LIBRARY=.*!TK_LIBRARY=${TK_LIBRARY}!g" \ +--- gcl-2.6.12.orig/h/386-gnu.h ++++ gcl-2.6.12/h/386-gnu.h +@@ -60,4 +60,4 @@ + + #define NEED_STACK_CHK_GUARD + +-#define DEFINED_REAL_MAXPAGE (1UL<<18) /*FIXME brk probe broken*/ ++#undef HAVE_D_TYPE /*FIXME defined, but not implemented in readdir*/ +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -307,8 +307,11 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_ + MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN")) + ) + #else ++#undef DT_UNKNOWN + #define DT_UNKNOWN 0 ++#undef DT_REG + #define DT_REG 1 ++#undef DT_DIR + #define DT_DIR 2 + list(3, + MMcons(make_fixnum(DT_REG),make_keyword("FILE")), diff --git a/patches/list_order.24 b/patches/list_order.24 new file mode 100644 index 00000000..04332178 --- /dev/null +++ b/patches/list_order.24 @@ -0,0 +1,44 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-63) unstable; urgency=medium + . + * list_order.23 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-02-04 + +--- gcl-2.6.12.orig/h/gmp_wrappers.h ++++ gcl-2.6.12/h/gmp_wrappers.h +@@ -148,6 +148,8 @@ MEM_GMP_CALL(1,gmp_ulint,mpz_popcount,0, + /*MEM_GMP_CALL(2,void *,mpz_realloc,mpz_t,mp_size_t)*/ + MEM_GMP_CALL(1,size_t,mpz_size,0,mpz_t) + MEM_GMP_CALL(2,size_t,mpz_sizeinbase,0,mpz_t,int) ++MEM_GMP_CALL(1,void,gmp_randinit_default,0,__gmp_randstate_struct *) ++MEM_GMP_CALL(2,void,gmp_randseed_ui,0,__gmp_randstate_struct *,unsigned long int) + + /* FIXME: find a way to have this follow the convention in gmp.h*/ + +@@ -191,5 +193,7 @@ MEM_GMP_CALL(2,size_t,mpz_sizeinbase,0,m + /*#define __gmpz_realloc m__gmpz_realloc*/ + #define __gmpz_size m__gmpz_size + #define __gmpz_sizeinbase m__gmpz_sizeinbase ++#define __gmp_randinit_default m__gmp_randinit_default ++#define __gmp_randseed_ui m__gmp_randseed_ui + + #endif /*GMP_WRAPPERS_H*/ diff --git a/patches/list_order.25 b/patches/list_order.25 new file mode 100644 index 00000000..ee4e2fb7 --- /dev/null +++ b/patches/list_order.25 @@ -0,0 +1,81 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-64) unstable; urgency=medium + . + * list_order.24 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2018-02-22 + +--- gcl-2.6.12.orig/makefile ++++ gcl-2.6.12/makefile +@@ -149,7 +149,7 @@ command: + merge: + $(CC) -o merge merge.c + +-LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/init_$(SYSTEM).lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) unixport/gcl.script ++LISP_LIB=cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp xgcl-2/sysdef.lisp xgcl-2/gcl_dwtest.lsp xgcl-2/gcl_dwtestcases.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/sys_init.lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) unixport/gcl.script + + install-command: + rm -f $(DESTDIR)$(prefix)/bin/gcl +--- gcl-2.6.12.orig/unixport/makefile ++++ gcl-2.6.12/unixport/makefile +@@ -69,13 +69,9 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l + [ "$(RL_OBJS)" = "" ] || \ + echo "(AUTOLOAD 'init-readline '|readline|)" >>$@ + +-saved_%:raw_% $(RSYM) sys_init.lsp.in raw_%_map msys \ +- $(CMPDIR)/gcl_cmpmain.lsp \ +- $(CMPDIR)/gcl_lfun_list.lsp \ +- $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ +- $(LSPDIR)/gcl_auto_new.lsp ++sys_init.lsp: sys_init.lsp.in + +- cat sys_init.lsp.in | sed \ ++ cat $< | sed \ + -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `cat ../release`#1" \ + -e "s#@LI-EXTVERS@#`cat ../minvers | cut -f2 -d.`#1" \ + -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ +@@ -87,8 +83,16 @@ saved_%:raw_% $(RSYM) sys_init.lsp.in ra + -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_POST)\"#1" \ + -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ + -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ +- -e "s#@LI-INIT-LSP@#\"$@\"#1" >foo ++ -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@ ++ ++ ++saved_%:raw_% $(RSYM) sys_init.lsp raw_%_map msys \ ++ $(CMPDIR)/gcl_cmpmain.lsp \ ++ $(CMPDIR)/gcl_lfun_list.lsp \ ++ $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \ ++ $(LSPDIR)/gcl_auto_new.lsp + ++ cp sys_init.lsp foo + echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo + j=$$(ar t lib$*.a |grep ^gcl_);[ "$$j" = "" ] || ar x lib$*.a $$j #accelerator + $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo +@@ -156,7 +160,7 @@ map_%: + # $(CC) $(LD_FLAGS) -c -o $@ plt.c $(CFLAGS) -I$(HDIR) -I$(ODIR) + + clean: +- rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \ ++ rm -rf saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) sys_init.lsp \ + $(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \ + gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script + diff --git a/patches/list_order.4 b/patches/list_order.4 new file mode 100644 index 00000000..bebb20d1 --- /dev/null +++ b/patches/list_order.4 @@ -0,0 +1,36 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-57) unstable; urgency=medium + . + * list_order.13 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-09-18 + +--- gcl-2.6.12.orig/lsp/gcl_directory.lsp ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -62,7 +62,7 @@ + (when (pathname-match-p dir v) + (push (merge-pathnames (parse-namestring dir nil *default-pathname-defaults* :start pos) pexp nil) r))) + :file) +- (when (pathname-match-p dir v) (push pexp r)))) ++ (when (pathname-match-p dir v) (push (pathname (copy-seq (namestring pexp))) r)))) + (make-frame "")) + r) + diff --git a/patches/list_order.5 b/patches/list_order.5 new file mode 100644 index 00000000..c3f200f8 --- /dev/null +++ b/patches/list_order.5 @@ -0,0 +1,205 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-48) unstable; urgency=medium + . + * list_order.1 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-08 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4188,6 +4188,7 @@ case $use in + mips*) + case $canonical in + mips64*linux*) ++# assert_arg_to_cflags -mxgot + assert_arg_to_ldflags -Wl,-z,now;; + esac + ;; +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -389,6 +389,7 @@ case $use in + mips*) + case $canonical in + mips64*linux*) ++# assert_arg_to_cflags -mxgot + assert_arg_to_ldflags -Wl,-z,now;; + esac + ;; +--- gcl-2.6.12.orig/h/elf64_mips_reloc.h ++++ gcl-2.6.12/h/elf64_mips_reloc.h +@@ -32,23 +32,14 @@ + if (s>=ggot && sr_addend=((void *)gote-(void *)got)-s; +- switch(tp) { +- case R_MIPS_GOT_HI16: +- case R_MIPS_CALL_HI16: +- r->r_info=((ul)R_MIPS_HI16<<56)|(r->r_info&MASK(32)); +- relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); +- break; +- case R_MIPS_GOT_LO16: +- case R_MIPS_CALL_LO16: +- r->r_info=((ul)R_MIPS_LO16<<56)|(r->r_info&MASK(32)); +- relocate(sym1,r,((Rela *)r)->r_addend,start,got,gote); +- break; +- default: +- store_val(where,MASK(16),((void *)gote-(void *)got)); +- break; +- } ++ *gote=s+(MIPS_HIGH(a)<<16); ++ a=(void *)gote-(void *)got; ++ if (tp==R_MIPS_GOT_HI16||tp==R_MIPS_CALL_HI16) ++ a=MIPS_HIGH(a); ++ else if (tp==R_MIPS_GOT_LO16||tp==R_MIPS_CALL_LO16) ++ a&=MASK(16); ++ massert(!(a&~MASK(16))); ++ store_val(where,MASK(16),a); + break; + case R_MIPS_GOT_OFST: + recurse(s+a); +@@ -63,8 +54,7 @@ + case R_MIPS_LO16: + recurse(s+a); + s+=a; +- a=*where&MASK(16); +- if (a&0x8000) a|=0xffffffffffff0000; ++ a=(short)*where; + a+=s&MASK(16); + a+=(a&0x8000)<<1; + store_val(where,MASK(16),a); +--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h ++++ gcl-2.6.12/h/elf64_mips_reloc_special.h +@@ -16,6 +16,7 @@ static ul ggot,ggote,la; static Rela *hr + + #undef ELF_R_TYPE + #define ELF_R_TYPE(a_) ELF_R_TYPE1(a_) ++#define MIPS_HIGH(a_) ({ul _a=(a_);(_a-(short)_a)>>16;}) + + typedef struct { + ul entry,gotoff; +@@ -98,12 +99,12 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + Sym *sym; + Shdr *sec; + void *v,*ve; +- ul q=0,a,b; ++ ul a,b; + + for (sym=sym1;symst_size=0; ++ sym->st_other=sym->st_size=0; + +- for (*gs=0,sec=sec1;secsh_type==SHT_RELA) + for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) + if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| +@@ -116,24 +117,37 @@ label_got_symbols(void *v1,Shdr *sec1,Sh + + sym=sym1+ELF_R_SYM(r->r_info); + +- a=r->r_addend>>15; ++ /*unlikely to save got space by recording possible holes in addend range*/ ++ if ((a=MIPS_HIGH(r->r_addend)+1)>sym->st_other) ++ sym->st_other=a; ++ ++ } + +- if (2*a>=sizeof(sym->st_size) || !((sym->st_size>>(a*16))&0xffff)) { ++ for (*gs=0,sec=sec1;secsh_type==SHT_RELA) ++ for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;vsh_entsize,r=v) ++ if (ELF_R_TYPE(r->r_info)==R_MIPS_CALL16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_DISP|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_HI16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_LO16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_HI16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_CALL_LO16|| ++ ELF_R_TYPE(r->r_info)==R_MIPS_GOT_PAGE) { + +- q=++*gs; +- if (2*ast_size)) { +- massert(q<=0xffff); +- sym->st_size|=(q<<(a*16)); +- } +- +- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ sym=sym1+ELF_R_SYM(r->r_info); + ++ if (sym->st_other) { ++ sym->st_size=++*gs; ++ if (sym->st_other>1) ++ (*gs)+=sym->st_other-1; ++ else ++ massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs)); ++ sym->st_other=0; + } + + b=sizeof(r->r_addend)*4; + massert(!(r->r_addend>>b)); +- q=2*a>=sizeof(sym->st_size) ? q : (sym->st_size>>(a*16))&0xffff; +- r->r_addend|=(q<<=b); ++ r->r_addend|=((sym->st_size+MIPS_HIGH(r->r_addend))<s=0; + unlock_pool(); + +- f.l_type=F_UNLCK; +- massert(!fcntl(pool,F_SETLK,&f)); +- +- fprintf(stderr,"Initializing pool\n"); +- fflush(stderr); +- + } + + f.l_type=F_RDLCK; +- massert(!fcntl(pool,F_SETLK,&f)); ++ plp=&f; ++ massert(!set_lock()); ++ ++ plp=&pl; + + register_pool(1); + massert(!atexit(close_pool)); diff --git a/patches/list_order.6 b/patches/list_order.6 new file mode 100644 index 00000000..285f16e7 --- /dev/null +++ b/patches/list_order.6 @@ -0,0 +1,103 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-49) unstable; urgency=medium + . + * list_order.5 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-13 + +--- gcl-2.6.12.orig/o/eval.c ++++ gcl-2.6.12/o/eval.c +@@ -96,18 +96,18 @@ quick_call_sfun(object fun) { + + } + +-/* only for sfun not gfun !! Does not check number of args */ +-static void +-call_sfun_no_check(object fun) +-{ DEBUG_AVMA +- int n; +- object *base=vs_base; +- n=vs_top - base; +- base[0]=c_apply_n_fun(fun,n,base); +- vs_top=(vs_base=base)+1; +- CHECK_AVMA; +- return; +-} ++/* /\* only for sfun not gfun !! Does not check number of args *\/ */ ++/* static void */ ++/* call_sfun_no_check(object fun) */ ++/* { DEBUG_AVMA */ ++/* int n; */ ++/* object *base=vs_base; */ ++/* n=vs_top - base; */ ++/* base[0]=c_apply_n_fun(fun,n,base); */ ++/* vs_top=(vs_base=base)+1; */ ++/* CHECK_AVMA; */ ++/* return; */ ++/* } */ + static void + call_vfun(object fun) + { DEBUG_AVMA +@@ -615,10 +615,11 @@ super_funcall_no_event(object fun) { + + switch(type_of(fun)) { + case t_cfun: +- (*fun->cf.cf_self)(); +- return; ++ (*fun->cf.cf_self)(); return; ++ case t_cclosure: ++ (*fun->cc.cc_self)(fun); return; + case t_sfun: +- call_sfun_no_check(fun); return; ++ /* call_sfun_no_check(fun); return; */ + case t_gfun: + quick_call_sfun(fun); return; + case t_vfun: +@@ -631,7 +632,7 @@ super_funcall_no_event(object fun) { + super_funcall_no_event(fun->s.s_gfdef); + return; + default: +- funcall_no_event(fun); ++ funcall(fun); + } + + } +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -1176,6 +1176,7 @@ Lsharp_left_parenthesis_reader() + goto L; + } + vs_base[0]=list(4,siScomma,sLapply,list(2,sLquote,sLvector),vs_base[2]); ++ vs_top=vs_base+1; + return; + } + vsp = vs_top; +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -369,7 +369,7 @@ memprotect_handler_test(int sig, long co + do_gcl_abort(); + } + memprotect_handler_invocations=1; +- if (faddr!=memprotect_test_address) ++ if (page(faddr)!=page(memprotect_test_address)) + memprotect_result=memprotect_bad_fault_address; + else + memprotect_result=memprotect_none; diff --git a/patches/list_order.7 b/patches/list_order.7 new file mode 100644 index 00000000..526b7ee5 --- /dev/null +++ b/patches/list_order.7 @@ -0,0 +1,47 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-50) unstable; urgency=medium + . + * list_order.6 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-14 + +--- gcl-2.6.12.orig/h/m68k-linux.h ++++ gcl-2.6.12/h/m68k-linux.h +@@ -63,7 +63,7 @@ + + + #define M68K +-#define SGC ++/* #define SGC *//*FIXME: Unknown m68k cpu in modern emulators*/ + + #include + int cacheflush(void *,int,int,int); +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -871,7 +871,7 @@ sgc_quit(void) { + f=n; + n=OBJ_LINK(n); + } +- SET_LINK(f,OBJNULL); ++ SET_LINK(f,n!=OBJNULL ? n : o); + tm->tm_tail=f; + tm->tm_nfree += tm->tm_alt_nfree; + tm->tm_alt_nfree = 0; diff --git a/patches/list_order.8 b/patches/list_order.8 new file mode 100644 index 00000000..37103e27 --- /dev/null +++ b/patches/list_order.8 @@ -0,0 +1,78 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-51) unstable; urgency=medium + . + * list_order.7 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-15 + +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -966,6 +966,11 @@ sweep_phase(void) { + STATIC object f; + STATIC struct pageinfo *v; + ++ for (j= t_start; j < t_contiguous ; j++) { ++ tm_of(j)->tm_free=OBJNULL; ++ tm_of(j)->tm_nfree=0; ++ } ++ + for (v=cell_list_head;v;v=v->next) { + + tm = tm_of((enum type)v->type); +@@ -975,22 +980,23 @@ sweep_phase(void) { + k = 0; + for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { + x = (object)p; +- if (is_free(x)) +- continue; +- else if (is_marked(x)) { ++ ++ if (is_marked(x)) { + unmark(x); + continue; + } + +- SET_LINK(f,x); + make_free(x); ++ SET_LINK(f,x); + f = x; + k++; ++ + } ++ + SET_LINK(f,OBJNULL); + tm->tm_tail = f; + tm->tm_nfree += k; +- pagetoinfo(page(v))->in_use-=k; ++ pagetoinfo(page(v))->in_use=tm->tm_nppage-k; + + } + +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -873,6 +873,7 @@ sgc_quit(void) { + } + SET_LINK(f,n!=OBJNULL ? n : o); + tm->tm_tail=f; ++ for (;OBJ_LINK(tm->tm_tail)!=OBJNULL;tm->tm_tail=OBJ_LINK(tm->tm_tail)); + tm->tm_nfree += tm->tm_alt_nfree; + tm->tm_alt_nfree = 0; + tm->tm_alt_free = OBJNULL; diff --git a/patches/list_order.9 b/patches/list_order.9 new file mode 100644 index 00000000..4cbf3b41 --- /dev/null +++ b/patches/list_order.9 @@ -0,0 +1,146 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-52) unstable; urgency=medium + . + * list_order.8 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-06-18 + +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -959,7 +959,7 @@ mark_c_stack(jmp_buf env1, int n, void ( + static void + sweep_phase(void) { + +- STATIC long j, k; ++ STATIC long j, k, l; + STATIC object x; + STATIC char *p; + STATIC struct typemanager *tm; +@@ -977,26 +977,28 @@ sweep_phase(void) { + + p = pagetochar(page(v)); + f = FREELIST_TAIL(tm); +- k = 0; ++ l = k = 0; + for (j = tm->tm_nppage; j > 0; --j, p += tm->tm_size) { + x = (object)p; + + if (is_marked(x)) { + unmark(x); ++ l++; + continue; + } + ++ k++; ++ + make_free(x); + SET_LINK(f,x); + f = x; +- k++; + + } + + SET_LINK(f,OBJNULL); + tm->tm_tail = f; + tm->tm_nfree += k; +- pagetoinfo(page(v))->in_use=tm->tm_nppage-k; ++ pagetoinfo(page(v))->in_use=l; + + } + +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -152,7 +152,7 @@ sgc_mark_phase(void) { + + static void + sgc_sweep_phase(void) { +- STATIC long j, k; ++ STATIC long j, k, l; + STATIC object x; + STATIC char *p; + STATIC struct typemanager *tm; +@@ -160,13 +160,18 @@ sgc_sweep_phase(void) { + int size; + STATIC struct pageinfo *v; + ++ for (j= t_start; j < t_contiguous ; j++) { ++ tm_of(j)->tm_free=OBJNULL; ++ tm_of(j)->tm_nfree=0; ++ } ++ + for (v=cell_list_head;v;v=v->next) { + + tm = tm_of((enum type)v->type); + + p = pagetochar(page(v)); + f = FREELIST_TAIL(tm); +- k = 0; ++ l = k = 0; + size=tm->tm_size; + + if (v->sgc_flags&SGC_PAGE_FLAG) { +@@ -175,10 +180,9 @@ sgc_sweep_phase(void) { + + x = (object)p; + +- if (is_free(x)) +- continue; +- else if (is_marked(x)) { ++ if (is_marked(x)) { + unmark(x); ++ l++; + continue; + } + +@@ -187,26 +191,26 @@ sgc_sweep_phase(void) { + continue; + #endif + +- /* it is ok to free x */ +- +- SET_LINK(f,x); ++ k++; + make_free(x); ++ SET_LINK(f,x); ++ f = x; ++ + #ifndef SGC_WHOLE_PAGE + if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT; + #endif +- f = x; +- k++; + + } ++ + SET_LINK(f,OBJNULL); + tm->tm_tail = f; + tm->tm_nfree += k; +- v->in_use-=k; ++ v->in_use=l; + + } else if (WRITABLE_PAGE_P(page(v))) /*non sgc_page */ + for (j = tm->tm_nppage; --j >= 0; p += size) { + x = (object)p; +- if (is_marked(x) && !is_free(x)) { ++ if (is_marked(x)) { + unmark(x); + } + } diff --git a/patches/pathnames1.1 b/patches/pathnames1.1 new file mode 100644 index 00000000..d4b661e1 --- /dev/null +++ b/patches/pathnames1.1 @@ -0,0 +1,18763 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-38) unstable; urgency=medium + . + * Version_2_6_13pre50 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-11 + +--- gcl-2.6.12.orig/ansi-tests/ansi-aux.lsp ++++ gcl-2.6.12/ansi-tests/ansi-aux.lsp +@@ -80,6 +80,10 @@ Results: ~A~%" expected-number form n re + "Like EQUALP, but guaranteed to return T for true." + (apply #'values (mapcar #'notnot (multiple-value-list (equalp x y))))) + ++(defun equalpt-or-report (x y) ++ "Like EQUALPT, but return either T or a list of the arguments." ++ (or (equalpt x y) (list x y))) ++ + (defun =t (x &rest args) + "Like =, but guaranteed to return T for true." + (apply #'values (mapcar #'notnot (multiple-value-list (apply #'= x args))))) +@@ -223,6 +227,13 @@ Results: ~A~%" expected-number form n re + P x p1 x TYPE p2) + t))))) + ++(defun check-predicate (predicate &optional guard (universe *universe*)) ++ "Return all elements of UNIVERSE for which the guard (if present) is false ++ and for which PREDICATE is false." ++ (remove-if #'(lambda (e) (or (and guard (funcall guard e)) ++ (funcall predicate e))) ++ universe)) ++ + (declaim (special *catch-error-type*)) + + (defun catch-continue-debugger-hook (condition dbh) +@@ -296,7 +307,167 @@ the condition to go uncaught if it canno + (defmacro classify-error (form) + `(classify-error** ',form)) + ++(defun sequencep (x) (typep x 'sequence)) ++ + ;;; ++(defun typef (type) #'(lambda (x) (typep x type))) ++ ++(defmacro signals-error (form error-name &key (safety 3) (name nil name-p) (inline nil)) ++ `(handler-bind ++ ((warning #'(lambda (c) (declare (ignore c)) ++ (muffle-warning)))) ++ (proclaim '(optimize (safety 3))) ++ (handler-case ++ (apply #'values ++ nil ++ (multiple-value-list ++ ,(cond ++ (inline form) ++ (regression-test::*compile-tests* ++ `(funcall (compile nil '(lambda () ++ (declare (optimize (safety ,safety))) ++ ,form)))) ++ (t `(eval ',form))))) ++ (,error-name (c) ++ (cond ++ ,@(case error-name ++ (type-error ++ `(((typep (type-error-datum c) ++ (type-error-expected-type c)) ++ (values ++ nil ++ (list (list 'typep (list 'quote ++ (type-error-datum c)) ++ (list 'quote ++ (type-error-expected-type c))) ++ "==> true"))))) ++ ((undefined-function unbound-variable) ++ (and name-p ++ `(((not (eq (cell-error-name c) ',name)) ++ (values ++ nil ++ (list 'cell-error-name "==>" ++ (cell-error-name c))))))) ++ ((stream-error end-of-file reader-error) ++ `(((not (streamp (stream-error-stream c))) ++ (values ++ nil ++ (list 'stream-error-stream "==>" ++ (stream-error-stream c)))))) ++ (file-error ++ `(((not (pathnamep (pathname (file-error-pathname c)))) ++ (values ++ nil ++ (list 'file-error-pathname "==>" ++ (file-error-pathname c)))))) ++ (t nil)) ++ (t (printable-p c))))))) ++ ++(defmacro signals-error-always (form error-name) ++ `(values ++ (signals-error ,form ,error-name) ++ (signals-error ,form ,error-name :safety 0))) ++ ++(defmacro signals-type-error (var datum-form form &key (safety 3) (inline nil)) ++ (let ((lambda-form ++ `(lambda (,var) ++ (declare (optimize (safety ,safety))) ++ ,form))) ++ `(let ((,var ,datum-form)) ++ (declare (optimize safety)) ++ (handler-bind ++ ((warning #'(lambda (c) (declare (ignore c)) ++ (muffle-warning)))) ++ ; (proclaim '(optimize (safety 3))) ++ (handler-case ++ (apply #'values ++ nil ++ (multiple-value-list ++ (funcall ++ ,(cond ++ (inline `(function ,lambda-form)) ++ (regression-test::*compile-tests* ++ `(compile nil ',lambda-form)) ++ (t `(eval ',lambda-form))) ++ ,var))) ++ (type-error ++ (c) ++ (let ((datum (type-error-datum c)) ++ (expected-type (type-error-expected-type c))) ++ (cond ++ ((not (eql ,var datum)) ++ (list :datum-mismatch ,var datum)) ++ ((typep datum expected-type) ++ (list :is-typep datum expected-type)) ++ (t (printable-p c)))))))))) ++ ++(declaim (special *mini-universe*)) ++ ++(defun check-type-error* (pred-fn guard-fn &optional (universe *mini-universe*)) ++ "Check that for all elements in some set, either guard-fn is true or ++ pred-fn signals a type error." ++ (let (val) ++ (loop for e in universe ++ unless (or (funcall guard-fn e) ++ (equal ++ (setf val (multiple-value-list ++ (signals-type-error x e (funcall pred-fn x) :inline t))) ++ '(t))) ++ collect (list e val)))) ++ ++(defmacro check-type-error (&body args) ++ `(locally (declare (optimize safety)) (check-type-error* ,@args))) ++ ++(defun printable-p (obj) ++ "Returns T iff obj can be printed to a string." ++ (with-standard-io-syntax ++ (let ((*print-readably* nil) ++ (*print-escape* nil)) ++ (declare (optimize safety)) ++ (handler-case (and (stringp (write-to-string obj)) t) ++ (condition (c) (declare (ignore c)) nil))))) ++ ++(defun make-special-string (string &key fill adjust displace base) ++ (let* ((len (length string)) ++ (len2 (if fill (+ len 4) len)) ++ (etype (if base 'base-char 'character))) ++ (if displace ++ (let ((s0 (make-array (+ len2 5) ++ :initial-contents ++ (concatenate 'string ++ (make-string 2 :initial-element #\X) ++ string ++ (make-string (if fill 7 3) ++ :initial-element #\Y)) ++ :element-type etype))) ++ (make-array len2 :element-type etype ++ :adjustable adjust ++ :fill-pointer (if fill len nil) ++ :displaced-to s0 ++ :displaced-index-offset 2)) ++ (make-array len2 :element-type etype ++ :initial-contents ++ (if fill (concatenate 'string string "ZZZZ") string) ++ :fill-pointer (if fill len nil) ++ :adjustable adjust)))) ++ ++(defmacro do-special-strings ((var string-form &optional ret-form) &body forms) ++ (let ((string (gensym)) ++ (fill (gensym "FILL")) ++ (adjust (gensym "ADJUST")) ++ (base (gensym "BASE")) ++ (displace (gensym "DISPLACE"))) ++ `(let ((,string ,string-form)) ++ (dolist (,fill '(nil t) ,ret-form) ++ (dolist (,adjust '(nil t)) ++ (dolist (,base '(nil t)) ++ (dolist (,displace '(nil t)) ++ (let ((,var (make-special-string ++ ,string ++ :fill ,fill :adjust ,adjust ++ :base ,base :displace ,displace))) ++ ,@forms)))))))) ++ + ;;; A scaffold is a structure that is used to remember the object + ;;; identities of the cons cells in a (noncircular) data structure. + ;;; This lets us check if the data structure has been changed by +@@ -1307,6 +1478,13 @@ the condition to go uncaught if it canno + (unuse-package package using-package))) + (delete-package package)))) + ++(defun delete-all-versions (pathspec) ++ "Replace the versions field of the pathname specified by pathspec with ++ :wild, and delete all the files this refers to." ++ (let* ((wild-pathname (make-pathname :version :wild :defaults (pathname pathspec))) ++ (truenames (directory wild-pathname))) ++ (mapc #'delete-file truenames))) ++ + (defconstant +fail-count-limit+ 20) + + (defmacro test-with-package-iterator (package-list-expr &rest symbol-types) +@@ -1455,3 +1633,5 @@ the condition to go uncaught if it canno + (list n1) + (random-partition n3 (- p 1 r)))))))))) + ++(defmacro expand-in-current-env (macro-form &environment env) ++ (macroexpand macro-form env)) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/broadcast-stream-streams.lsp +@@ -0,0 +1,30 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 29 22:06:28 2004 ++;;;; Contains: Tests of BROADCAST-STREAM-STREAMS ++ ++(in-package :cl-test) ++ ++(deftest broadcast-stream-streams.1 ++ (broadcast-stream-streams (make-broadcast-stream)) ++ nil) ++ ++(deftest broadcast-stream-streams.2 ++ (equalt ++ (broadcast-stream-streams (make-broadcast-stream *standard-output*)) ++ (list *standard-output*)) ++ t) ++ ++(deftest broadcast-stream-streams.error.1 ++ (signals-error (broadcast-stream-streams) program-error) ++ t) ++ ++(deftest broadcast-stream-streams.error.2 ++ (signals-error (broadcast-stream-streams (make-broadcast-stream) nil) ++ program-error) ++ t) ++ ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/clear-input.lsp +@@ -0,0 +1,64 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 28 06:12:39 2004 ++;;;; Contains: Tests of CLEAR-INPUT ++ ++(in-package :cl-test) ++ ++;;; These tests are limited, since whether an input stream can be ++;;; cleared is not well specified. ++ ++(deftest clear-input.1 ++ (loop for s in (list *debug-io* *query-io* ++ *standard-input* *terminal-io*) ++ always (eq (clear-input s) nil)) ++ t) ++ ++(deftest clear-input.2 ++ (clear-input) ++ nil) ++ ++(deftest clear-input.3 ++ (clear-input nil) ++ nil) ++ ++(deftest clear-input.4 ++ (clear-input t) ++ nil) ++ ++(deftest clear-input.5 ++ (with-input-from-string ++ (is "!?*") ++ (let ((*terminal-io* (make-two-way-stream is (make-broadcast-stream)))) ++ (clear-input t))) ++ nil) ++ ++(deftest clear-input.6 ++ (with-input-from-string ++ (*standard-input* "345") ++ (clear-input nil)) ++ nil) ++ ++;;; Error cases ++ ++(deftest clear-input.error.1 ++ :notes (:assume-no-simple-streams) ++ (signals-error (clear-input t nil) program-error) ++ t) ++ ++(deftest clear-input.error.2 ++ :notes (:assume-no-simple-streams) ++ (signals-error (clear-input nil nil) program-error) ++ t) ++ ++(deftest clear-input.error.3 ++ (signals-error (clear-input t nil nil) program-error) ++ t) ++ ++(deftest clear-input.error.4 ++ (signals-error (clear-input nil nil nil) program-error) ++ t) ++ ++(deftest clear-input.error.5 ++ (check-type-error #'clear-input #'(lambda (x) (typep x '(or stream (member nil t))))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/clear-output.lsp +@@ -0,0 +1,53 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 28 06:43:17 2004 ++;;;; Contains: Tests of CLEAR-OUTPUT ++ ++(in-package :cl-test) ++ ++(deftest clear-output.1 ++ (progn (finish-output) (clear-output)) ++ nil) ++ ++(deftest clear-output.2 ++ (progn (finish-output) (clear-output t)) ++ nil) ++ ++(deftest clear-output.3 ++ (progn (finish-output) (clear-output nil)) ++ nil) ++ ++(deftest clear-output.4 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-output* *trace-output* *terminal-io*) ++ for dummy = (finish-output s) ++ for results = (multiple-value-list (clear-output s)) ++ unless (equal results '(nil)) ++ collect s) ++ nil) ++ ++(deftest clear-output.5 ++ (let ((os (make-string-output-stream))) ++ (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") ++ os))) ++ (clear-output t))) ++ nil) ++ ++(deftest clear-output.6 ++ (let ((*standard-output* (make-string-output-stream))) ++ (clear-output nil)) ++ nil) ++ ++;;; Error tests ++ ++(deftest clear-output.error.1 ++ (signals-error (clear-output nil nil) program-error) ++ t) ++ ++(deftest clear-output.error.2 ++ (signals-error (clear-output t nil) program-error) ++ t) ++ ++(deftest clear-output.error.3 ++ (check-type-error #'clear-output #'(lambda (x) (typep x '(or stream (member nil t))))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/compile-file-test-file.lsp +@@ -0,0 +1,3 @@ ++(in-package "CL-TEST") ++ ++(defun compile-file-test-fun.1 () nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/concatenated-stream-streams.lsp +@@ -0,0 +1,67 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 08:43:45 2004 ++;;;; Contains: Tests of CONCATENATED-STREAM-STREAMS ++ ++(in-package :cl-test) ++ ++(deftest concatenated-stream-streams.1 ++ (concatenated-stream-streams (make-concatenated-stream)) ++ nil) ++ ++(deftest concatenated-stream-streams.2 ++ (equalt (list (list *standard-input*)) ++ (multiple-value-list ++ (concatenated-stream-streams ++ (make-concatenated-stream *standard-input*)))) ++ t) ++ ++(deftest concatenated-stream-streams.3 ++ (with-input-from-string ++ (s1 "abc") ++ (with-input-from-string ++ (s2 "def") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (equalt (list (list s1 s2)) ++ (multiple-value-list ++ (concatenated-stream-streams s)))))) ++ t) ++ ++(deftest concatenated-stream-streams.4 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "def") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (equalt (list (list s1 s2)) ++ (multiple-value-list ++ (concatenated-stream-streams s)))))) ++ t) ++ ++(deftest concatenated-stream-streams.5 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "def") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (values ++ (read-char s) ++ (equalt (list (list s2)) ++ (multiple-value-list ++ (concatenated-stream-streams s))))))) ++ #\d t) ++ ++;;; Error cases ++ ++(deftest concatenated-stream-streams.error.1 ++ (signals-error (concatenated-stream-streams) program-error) ++ t) ++ ++(deftest concatenated-stream-streams.error.2 ++ (signals-error (concatenated-stream-streams ++ (make-concatenated-stream) ++ nil) ++ program-error) ++ t) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/delete-file.lsp +@@ -0,0 +1,95 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 18:42:29 2004 ++;;;; Contains: Tests for DELETE-FILE ++ ++(in-package :cl-test) ++ ++(deftest delete-file.1 ++ (let ((pn "scratchfile.txt")) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (values ++ (notnot (probe-file pn)) ++ (multiple-value-list (delete-file pn)) ++ (probe-file pn))) ++ t (t) nil) ++ ++(deftest delete-file.2 ++ (let ((pn #p"scratchfile.txt")) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (values ++ (notnot (probe-file pn)) ++ (multiple-value-list (delete-file pn)) ++ (probe-file pn))) ++ t (t) nil) ++ ++(deftest delete-file.3 ++ (let ((pn "CLTEST:SCRATCHFILE.TXT")) ++ (assert (typep (pathname pn) 'logical-pathname)) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (values ++ (notnot (probe-file pn)) ++ (multiple-value-list (delete-file pn)) ++ (probe-file pn))) ++ t (t) nil) ++ ++(deftest delete-file.4 ++ (let ((pn "CLTEST:SCRATCHFILE.TXT")) ++ (assert (typep (pathname pn) 'logical-pathname)) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (let ((s (open pn :direction :input))) ++ (close s) ++ (values ++ (notnot (probe-file pn)) ++ (multiple-value-list (delete-file s)) ++ (probe-file pn)))) ++ t (t) nil) ++ ++;;; Specialized string tests ++ ++(deftest delete-file.5 ++ (do-special-strings ++ (pn "scratchfile.txt" nil) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (assert (probe-file pn)) ++ (assert (equal (multiple-value-list (delete-file pn)) '(t))) ++ (assert (not (probe-file pn)))) ++ nil) ++ ++;;; Error tests ++ ++(deftest delete-file.error.1 ++ (signals-error (delete-file) program-error) ++ t) ++ ++(deftest delete-file.error.2 ++ (let ((pn "scratch.txt")) ++ (unless (probe-file pn) ++ (with-open-file (s pn :direction :output) ++ (format s "Contents~%"))) ++ (values ++ (notnot (probe-file pn)) ++ (signals-error (delete-file "scratch.txt" nil) program-error) ++ (notnot (probe-file pn)) ++ (delete-file pn) ++ (probe-file pn))) ++ t t t t nil) ++ ++#| ++(deftest delete-file.error.3 ++ (let ((pn "nonexistent.txt")) ++ (when (probe-file pn) (delete-file pn)) ++ (signals-error (delete-file "nonexistent.txt") file-error)) ++ t) ++|# ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/directory-namestring.lsp +@@ -0,0 +1,50 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Sep 12 06:21:42 2004 ++;;;; Contains: Tests for DIRECTORY-NAMESTRING ++ ++(in-package :cl-test) ++ ++(deftest directory-namestring.1 ++ (let* ((vals (multiple-value-list ++ (directory-namestring "directory-namestring.lsp"))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (directory-namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest directory-namestring.2 ++ (do-special-strings ++ (s "directory-namestring.lsp" nil) ++ (let ((ns (directory-namestring s))) ++ (assert (stringp ns)) ++ (assert (string= (directory-namestring ns) ns)))) ++ nil) ++ ++;;; Lispworks makes another assumption about filename normalization ++;;; when using file streams as pathname designators, so this test ++;;; doesn't work there. ++;;; (This is another example of the difficulty of testing a feature ++;;; in which so much is left up to the implementation.) ++#-lispworks ++(deftest directory-namestring.3 ++ (let* ((name "directory-namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (with-open-file (s pn :direction :input) ++ (directory-namestring s))) ++ (name3 (directory-namestring pn))) ++ (or (equalt name2 name3) (list name2 name3))) ++ t) ++ ++;;; Error tests ++ ++(deftest directory-namestring.error.1 ++ (signals-error (directory-namestring) program-error) ++ t) ++ ++(deftest directory-namestring.error.2 ++ (signals-error (directory-namestring "directory-namestring.lsp" nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/directory.lsp +@@ -0,0 +1,71 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 1 12:00:18 2004 ++;;;; Contains: Tests of DIRECTORY ++ ++(in-package :cl-test) ++ ++(deftest directory.1 ++ (directory "nonexistent") ++ nil) ++ ++(deftest directory.2 ++ (directory #p"nonexistent") ++ nil) ++ ++(deftest directory.3 ++ (directory "nonexistent" :allow-other-keys nil) ++ nil) ++ ++(deftest directory.4 ++ (directory "nonexistent" :allow-other-keys t :foo 'bar) ++ nil) ++ ++(deftest directory.5 ++ (directory "nonexistent" :foo 0 :allow-other-keys t) ++ nil) ++ ++(deftest directory.6 ++ (let* ((pattern-pathname (make-pathname :name :wild :type :wild ++ :defaults *default-pathname-defaults*)) ++ (pathnames (directory pattern-pathname))) ++ (values ++ (remove-if #'pathnamep pathnames) ++ (loop for pn in pathnames ++ unless (equal pn (truename pn)) ++ collect pn) ++;; (loop for pn in pathnames ++;; unless (pathname-match-p pn pattern-pathname) ++;; collect pn)) ++ )) ++ nil nil ;; nil ++ ) ++ ++(deftest directory.7 ++ (let* ((pattern-pathname (make-pathname :name :wild :type :wild ++ :defaults *default-pathname-defaults*)) ++ (pathnames (directory pattern-pathname))) ++ (loop for pn in pathnames ++ unless (equal pn (probe-file pn)) ++ collect pn)) ++ nil) ++ ++(deftest directory.8 ++ (let* ((pathname-pattern "CLTEST:*.*") ++ (len (length (directory pathname-pattern)))) ++ (if (< len 300) len nil)) ++ nil) ++ ++;;; Specialized string tests ++ ++(deftest directory.9 ++ (do-special-strings ++ (s "nonexistent" nil) ++ (assert (null (directory s)))) ++ nil) ++ ++;;; Error tests ++ ++(deftest directory.error.1 ++ (signals-error (directory) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/echo-stream-input-stream.lsp +@@ -0,0 +1,27 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Feb 12 04:30:40 2004 ++;;;; Contains: Tests of ECHO-STREAM-INPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest echo-stream-input-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (equalt (multiple-value-list (echo-stream-input-stream s)) ++ (list is))) ++ t) ++ ++(deftest echo-stream-input-stream.error.1 ++ (signals-error (echo-stream-input-stream) program-error) ++ t) ++ ++(deftest echo-stream-input-stream.error.2 ++ (signals-error (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (echo-stream-input-stream s nil)) ++ program-error) ++ t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/echo-stream-output-stream.lsp +@@ -0,0 +1,26 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Feb 12 04:32:33 2004 ++;;;; Contains: Tests off ECHO-STREAM-OUTPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest echo-stream-output-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (equalt (multiple-value-list (echo-stream-output-stream s)) ++ (list os))) ++ t) ++ ++(deftest echo-stream-output-stream.error.1 ++ (signals-error (echo-stream-output-stream) program-error) ++ t) ++ ++(deftest echo-stream-output-stream.error.2 ++ (signals-error (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (echo-stream-output-stream s nil)) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/enough-namestring.lsp +@@ -0,0 +1,84 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Sep 12 06:23:50 2004 ++;;;; Contains: Tests of ENOUGH-NAMESTRING ++ ++(in-package :cl-test) ++ ++(deftest enough-namestring.1 ++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp"))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (enough-namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest enough-namestring.2 ++ (do-special-strings ++ (s "enough-namestring.lsp" nil) ++ (let ((ns (enough-namestring s))) ++ (assert (stringp ns)) ++ (assert (string= (enough-namestring ns) ns)))) ++ nil) ++ ++(deftest enough-namestring.3 ++ (let* ((name "enough-namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (enough-namestring pn)) ++ (name3 (enough-namestring name))) ++ (or (equalt name2 name3) (list name2 name3))) ++ t) ++ ++(deftest enough-namestring.4 ++ (let* ((name "enough-namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (with-open-file (s pn :direction :input) (enough-namestring s))) ++ (name3 (enough-namestring name))) ++ (or (equalt name2 name3) (list name2 name3))) ++ t) ++ ++(deftest enough-namestring.5 ++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" ++ *default-pathname-defaults*))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (enough-namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest enough-namestring.6 ++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" ++ (namestring *default-pathname-defaults*)))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (enough-namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest enough-namestring.7 ++ (do-special-strings ++ (s (namestring *default-pathname-defaults*) nil) ++ (let* ((vals (multiple-value-list (enough-namestring "enough-namestring.lsp" s))) ++ (s2 (first vals))) ++ (assert (null (cdr vals))) ++ (assert (stringp s2)) ++ (assert (equal (enough-namestring s2) s2)))) ++ nil) ++ ++;;; Error tests ++ ++(deftest enough-namestring.error.1 ++ (signals-error (enough-namestring) program-error) ++ t) ++ ++(deftest enough-namestring.error.2 ++ (signals-error ++ (enough-namestring "enough-namestring.lsp" *default-pathname-defaults* nil) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/ensure-directories-exist.lsp +@@ -0,0 +1,166 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Jan 5 20:53:03 2004 ++;;;; Contains: Tests of ENSURE-DIRECTORIES-EXIST ++ ++(in-package :cl-test) ++ ++(deftest ensure-directories-exist.1 ++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" ++ :defaults *default-pathname-defaults*)) ++ (results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list (ensure-directories-exist pn)))))) ++ (values ++ (length results) ++ (equalt (truename pn) (truename (first results))) ++ (second results) ++ verbosity)) ++ 2 t nil "") ++ ++(deftest ensure-directories-exist.2 ++ (with-open-file ++ (s "ensure-directories-exist.lsp" :direction :input) ++ (let* ((results (multiple-value-list (ensure-directories-exist s)))) ++ (values ++ (length results) ++ (equalt (truename (first results)) (truename s)) ++ (second results)))) ++ 2 t nil) ++ ++(deftest ensure-directories-exist.3 ++ (let ((s (open "ensure-directories-exist.lsp" :direction :input))) ++ (close s) ++ (let* ((results (multiple-value-list (ensure-directories-exist s)))) ++ (values ++ (length results) ++ (equalt (truename (first results)) (truename s)) ++ (second results)))) ++ 2 t nil) ++ ++(deftest ensure-directories-exist.4 ++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" ++ :defaults *default-pathname-defaults*)) ++ (results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list ++ (ensure-directories-exist pn :verbose nil)))))) ++ (values ++ (length results) ++ (equalt (truename pn) (truename (first results))) ++ (second results) ++ verbosity)) ++ 2 t nil "") ++ ++(deftest ensure-directories-exist.5 ++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" ++ :defaults *default-pathname-defaults*)) ++ (results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list ++ (ensure-directories-exist pn :verbose t)))))) ++ (values ++ (length results) ++ (equalt (truename pn) (truename (first results))) ++ (second results) ++ verbosity)) ++ 2 t nil "") ++ ++(deftest ensure-directories-exist.6 ++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" ++ :defaults *default-pathname-defaults*)) ++ (results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list ++ (ensure-directories-exist ++ pn :allow-other-keys nil)))))) ++ (values ++ (length results) ++ (equalt (truename pn) (truename (first results))) ++ (second results) ++ verbosity)) ++ 2 t nil "") ++ ++(deftest ensure-directories-exist.7 ++ (let* ((pn (make-pathname :name "ensure-directories-exist.lsp" ++ :defaults *default-pathname-defaults*)) ++ (results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list ++ (ensure-directories-exist ++ pn :allow-other-keys t :nonsense t)))))) ++ (values ++ (length results) ++ (equalt (truename pn) (truename (first results))) ++ (second results) ++ verbosity)) ++ 2 t nil "") ++ ++;;; Case where directory shouldn't exist ++ ++;; The directort ansi-tests/scratch must not exist before this ++;; test is run ++(deftest ensure-directories-exist.8 ++ (let* ((subdir (make-pathname :directory '(:relative "scratch") ++ :defaults *default-pathname-defaults*)) ++ (pn (make-pathname :name "foo" :type "txt" ++ :defaults subdir))) ++ (ignore-errors (delete-file pn) (delete-file subdir)) ++ (assert (not (probe-file pn)) () ++ "Delete subdirectory scratch and its contents!") ++ (let* ((results nil) ++ (verbosity ++ (with-output-to-string ++ (*standard-output*) ++ (setq results (multiple-value-list (ensure-directories-exist pn))))) ++ (result-pn (first results)) ++ (created (second results))) ++ ;; Create the file and write to it ++ (with-open-file (*standard-output* ++ pn :direction :output :if-exists :error ++ :if-does-not-exist :create) ++ (print nil)) ++ (values ++ (length results) ++ (notnot created) ++ (equalt pn result-pn) ++ (notnot (probe-file pn)) ++ verbosity ++ ))) ++ 2 t t t "") ++ ++;;; Specialized string tests ++ ++(deftest ensure-directories-exist.9 ++ (do-special-strings ++ (str "ensure-directories-exist.lsp" nil) ++ (let* ((results (multiple-value-list (ensure-directories-exist str)))) ++ (assert (eql (length results) 2)) ++ (assert (equalt (truename (first results)) (truename str))) ++ (assert (null (second results))))) ++ nil) ++ ++;; FIXME ++;; Need to add a LPN test ++ ++(deftest ensure-directories-exist.error.1 ++ (signals-error-always ++ (ensure-directories-exist ++ (make-pathname :directory '(:relative :wild) ++ :defaults *default-pathname-defaults*)) ++ file-error) ++ t t) ++ ++(deftest ensure-directories-exist.error.2 ++ (signals-error (ensure-directories-exist) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-author.lsp +@@ -0,0 +1,88 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 6 05:41:06 2004 ++;;;; Contains: Tests of FILE-AUTHOR ++ ++(in-package :cl-test) ++ ++(deftest file-author.1 ++ (loop for pn in ++ (directory (make-pathname :name :wild :type :wild ++ :defaults *default-pathname-defaults*)) ++ for author = (file-author pn) ++ unless (or (null author) (stringp author)) ++ collect (list pn author)) ++ nil) ++ ++(deftest file-author.2 ++ (let ((author (file-author "file-author.lsp"))) ++ (if (or (null author) (stringp author)) ++ nil ++ author)) ++ nil) ++ ++(deftest file-author.3 ++ (let ((author (file-author #p"file-author.lsp"))) ++ (if (or (null author) (stringp author)) ++ nil ++ author)) ++ nil) ++ ++(deftest file-author.4 ++ (let ((author (file-author (truename "file-author.lsp")))) ++ (if (or (null author) (stringp author)) ++ nil ++ author)) ++ nil) ++ ++(deftest file-author.5 ++ (let ((author (with-open-file (s "file-author.lsp" :direction :input) ++ (file-author s)))) ++ (if (or (null author) (stringp author)) ++ nil ++ author)) ++ nil) ++ ++(deftest file-author.6 ++ (let ((author (let ((s (open "file-author.lsp" :direction :input))) ++ (close s) ++ (file-author s)))) ++ (if (or (null author) (stringp author)) ++ nil ++ author)) ++ nil) ++ ++;;; Specialized string tests ++ ++(deftest file-author.7 ++ (do-special-strings ++ (s "file-author.lsp" nil) ++ (assert (equal (file-author s) (file-author "file-author.lsp")))) ++ nil) ++ ++;;; FIXME ++;;; Add LPN test ++ ++;;; Error tests ++ ++(deftest file-author.error.1 ++ (signals-error (file-author) program-error) ++ t) ++ ++(deftest file-author.error.2 ++ (signals-error (file-author "file-author.lsp" nil) program-error) ++ t) ++ ++(deftest file-author.error.3 ++ (signals-error-always ++ (file-author (make-pathname :name :wild :type "lsp" ++ :defaults *default-pathname-defaults*)) ++ file-error) ++ t t) ++ ++(deftest file-author.error.4 ++ (signals-error-always ++ (file-author (make-pathname :name "file-author" :type :wild ++ :defaults *default-pathname-defaults*)) ++ file-error) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-error.lsp +@@ -0,0 +1,89 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:10:02 2004 ++;;;; Contains: Tests of the FILE-ERROR condition, and associated accessor function ++ ++(in-package :cl-test) ++ ++(deftest file-error.1 ++ (let ((pn (make-pathname :name :wild ++ :type "txt" ++ :version :newest ++ :defaults *default-pathname-defaults*))) ++ (handler-case ++ (probe-file pn) ++ (error (c) ++ (values ++ (notnot (typep c 'file-error)) ++ (if (equalp (file-error-pathname c) pn) ++ t ++ (list (file-error-pathname c) pn)))))) ++ t t) ++ ++(deftest file-error-pathname.1 ++ (let ((c (make-condition 'file-error :pathname "foo.txt"))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (file-error-pathname c))) ++ t t "foo.txt") ++ ++(deftest file-error-pathname.2 ++ (let ((c (make-condition 'file-error :pathname #p"foo.txt"))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (equalt #p"foo.txt" (file-error-pathname c)))) ++ t t t) ++ ++(deftest file-error-pathname.3 ++ (let ((c (make-condition 'file-error :pathname "CLTEST:FOO.TXT"))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (equalpt "CLTEST:FOO.TXT" ++ (file-error-pathname c)))) ++ t t t) ++ ++(deftest file-error-pathname.4 ++ (let ((c (make-condition 'file-error :pathname (logical-pathname "CLTEST:FOO.TXT")))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (equalpt (logical-pathname "CLTEST:FOO.TXT") ++ (file-error-pathname c)))) ++ t t t) ++ ++(deftest file-error-pathname.5 ++ (with-open-file (s "file-error.lsp" :direction :input) ++ (let ((c (make-condition 'file-error :pathname s))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (equalpt s (file-error-pathname c))))) ++ t t t) ++ ++(deftest file-error-pathname.6 ++ (let ((s (open "file-error.lsp" :direction :input))) ++ (close s) ++ (let ((c (make-condition 'file-error :pathname s))) ++ (values ++ (notnot (typep c 'file-error)) ++ (eqlt (class-of c) (find-class 'file-error)) ++ (equalpt s (file-error-pathname c))))) ++ t t t) ++ ++(deftest file-error-pathname.error.1 ++ (signals-error (file-error-pathname) program-error) ++ t) ++ ++(deftest file-error-pathname.error.2 ++ (signals-error ++ (file-error-pathname (make-condition 'file-error :pathname "foo.txt") nil) ++ program-error) ++ t) ++ ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-length.lsp +@@ -0,0 +1,176 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 21 06:21:11 2004 ++;;;; Contains: Tests of FILE-LENGTH ++ ++(in-package :cl-test) ++ ++(deftest file-length.error.1 ++ (signals-error (file-length) program-error) ++ t) ++ ++(deftest file-length.error.2 ++ (signals-error ++ (with-open-file (is "file-length.lsp" :direction :input) ++ (file-length is nil)) ++ program-error) ++ t) ++ ++(deftest file-length.error.3 ++ (loop for x in *mini-universe* ++ unless (or (typep x 'file-stream) ++ (typep x 'broadcast-stream) ++ (handler-case (progn (file-length x) nil) ++ (type-error (c) ++ (assert (not (typep x (type-error-expected-type c)))) ++ t) ++ (condition () nil))) ++ collect x) ++ nil) ++ ++(deftest file-length.error.4 ++ :notes (:assume-no-simple-streams :assume-no-gray-streams) ++ (signals-error (with-input-from-string (s "abc") (file-length s)) ++ type-error) ++ t) ++ ++(deftest file-length.error.5 ++ (signals-error ++ (with-open-file ++ (is "file-length.lsp" :direction :input) ++ (with-open-file ++ (os "tmp.txt" :direction :output :if-exists :supersede) ++ (let ((s (make-two-way-stream is os))) ++ (unwind-protect (file-length s) (close s))))) ++ type-error) ++ t) ++ ++(deftest file-length.error.6 ++ (signals-error ++ (with-open-file ++ (is "file-length.lsp" :direction :input) ++ (with-open-file ++ (os "tmp.txt" :direction :output :if-exists :supersede) ++ (let ((s (make-echo-stream is os))) ++ (unwind-protect (file-length s) (close s))))) ++ type-error) ++ t) ++ ++(deftest file-length.error.8 ++ (with-open-file ++ (os "tmp.txt" :direction :output :if-exists :supersede) ++ (let ((s (make-broadcast-stream os))) ++ (eqlt (file-length s) (file-length os)))) ++ t) ++ ++(deftest file-length.error.9 ++ (signals-type-error s (make-concatenated-stream) ++ (unwind-protect (file-length s) (close s))) ++ t) ++ ++(deftest file-length.error.10 ++ (signals-error ++ (with-open-file ++ (is "file-length.lsp" :direction :input) ++ (let ((s (make-concatenated-stream is))) ++ (unwind-protect (file-length s) (close s)))) ++ type-error) ++ t) ++ ++(deftest file-length.error.11 ++ :notes (:assume-no-simple-streams :assume-no-gray-streams) ++ (signals-type-error s (make-string-input-stream "abcde") ++ (unwind-protect (file-length s) (close s))) ++ t) ++ ++(deftest file-length.error.12 ++ :notes (:assume-no-simple-streams :assume-no-gray-streams) ++ (signals-type-error s (make-string-output-stream) ++ (unwind-protect (file-length s) (close s))) ++ t) ++ ++;;; Non-error tests ++ ++(deftest file-length.1 ++ (let ((results (multiple-value-list ++ (with-open-file ++ (is "file-length.lsp" :direction :input) ++ (file-length is))))) ++ (and (= (length results) 1) ++ (typep (car results) '(integer 1)) ++ t)) ++ t) ++ ++(deftest file-length.2 ++ (loop for i from 1 to 32 ++ for etype = `(unsigned-byte ,i) ++ for e = (max 0 (- (ash 1 i) 5)) ++ for os = (open "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type etype) ++ do (loop repeat 17 do (write-byte e os)) ++ do (finish-output os) ++ unless (= (file-length os) 17) ++ collect (list i (file-length os)) ++ do (close os)) ++ nil) ++ ++(deftest file-length.3 ++ (loop for i from 1 to 32 ++ for etype = `(unsigned-byte ,i) ++ for e = (max 0 (- (ash 1 i) 5)) ++ for os = (open "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type etype) ++ for len = 0 ++ do (loop repeat 17 do (write-byte e os)) ++ do (close os) ++ unless (let ((is (open "tmp.dat" :direction :input ++ :element-type etype))) ++ (prog1 ++ (= (file-length is) 17) ++ (close is))) ++ collect i) ++ nil) ++ ++(deftest file-length.4 ++ (loop for i from 33 to 100 ++ for etype = `(unsigned-byte ,i) ++ for e = (max 0 (- (ash 1 i) 5)) ++ for os = (open "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type etype) ++ do (loop repeat 17 do (write-byte e os)) ++ do (finish-output os) ++ unless (= (file-length os) 17) ++ collect (list i (file-length os)) ++ do (close os)) ++ nil) ++ ++(deftest file-length.5 ++ (loop for i from 33 to 100 ++ for etype = `(unsigned-byte ,i) ++ for e = (max 0 (- (ash 1 i) 5)) ++ for os = (open "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type etype) ++ for len = 0 ++ do (loop repeat 17 do (write-byte e os)) ++ do (close os) ++ unless (let ((is (open "tmp.dat" :direction :input ++ :element-type etype))) ++ (prog1 ++ (= (file-length is) 17) ++ (close is))) ++ collect i) ++ nil) ++ ++(deftest file-length.6 ++ (with-open-file ++ (*foo* "file-length.lsp" :direction :input) ++ (declare (special *foo*)) ++ (let ((s (make-synonym-stream '*foo*))) ++ (unwind-protect ++ (typep* (file-length s) '(integer 1)) ++ (close s)))) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-namestring.lsp +@@ -0,0 +1,44 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Sep 11 07:40:47 2004 ++;;;; Contains: Tests for FILE-NAMESTRING ++ ++(in-package :cl-test) ++ ++(deftest file-namestring.1 ++ (let* ((vals (multiple-value-list ++ (file-namestring "file-namestring.lsp"))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (file-namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest file-namestring.2 ++ (do-special-strings ++ (s "file-namestring.lsp" nil) ++ (let ((ns (file-namestring s))) ++ (assert (stringp ns)) ++ (assert (string= (file-namestring ns) ns)))) ++ nil) ++ ++(deftest file-namestring.3 ++ (let* ((name "file-namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (with-open-file (s pn :direction :input) ++ (file-namestring s))) ++ (name3 (file-namestring pn))) ++ (or (equalt name2 name3) (list name2 name3))) ++ t) ++ ++;;; Error tests ++ ++(deftest file-namestring.error.1 ++ (signals-error (file-namestring) program-error) ++ t) ++ ++(deftest file-namestring.error.2 ++ (signals-error (file-namestring "file-namestring.lsp" nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-position.lsp +@@ -0,0 +1,170 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 22 03:02:31 2004 ++;;;; Contains: Tests of FILE-POSITION ++ ++(in-package :cl-test) ++ ++(deftest file-position.1 ++ (with-open-file (is "file-position.lsp":direction :input) ++ (file-position is)) ++ 0) ++ ++(deftest file-position.2 ++ (with-open-file (is "file-position.lsp":direction :input) ++ (values ++ (multiple-value-list ++ (notnot-mv (file-position is :start))) ++ (file-position is))) ++ ++ (t) 0) ++ ++(deftest file-position.3 ++ (with-open-file (is "file-position.lsp":direction :input) ++ (values ++ (multiple-value-list ++ (notnot-mv (file-position is :end))) ++ (notnot (> (file-position is) 0)))) ++ (t) t) ++ ++(deftest file-position.4 ++ (with-open-file ++ (is "file-position.lsp":direction :input) ++ (values ++ (file-position is) ++ (read-char is) ++ (notnot (> (file-position is) 0)))) ++ 0 #\; t) ++ ++(deftest file-position.5 ++ (with-open-file ++ (os "tmp.dat":direction :output ++ :if-exists :supersede) ++ (values ++ (file-position os) ++ (write-char #\x os) ++ (notnot (> (file-position os) 0)))) ++ 0 #\x t) ++ ++(deftest file-position.6 ++ (with-open-file ++ (os "tmp.dat":direction :output ++ :if-exists :supersede) ++ (let ((p1 (file-position os)) ++ (delta (file-string-length os #\x))) ++ (write-char #\x os) ++ (let ((p2 (file-position os))) ++ (or (null p1) (null p2) (null delta) ++ (=t (+ p1 delta) p2))))) ++ t) ++ ++;;; Byte streams ++ ++(deftest file-position.7 ++ (loop for len from 1 to 32 ++ for n = (ash 1 len) ++ do (with-open-file ++ (os "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type `(unsigned-byte ,len)) ++ (loop for i from 0 below 100 ++ for r = (logand (1- n) i) ++ for pos = (file-position os) ++ do (assert (or (not pos) (eql pos i))) ++ do (write-byte r os))) ++ do (with-open-file ++ (is "tmp.dat" :direction :input ++ :element-type `(unsigned-byte ,len)) ++ (loop for i from 0 below 100 ++ for pos = (file-position is) ++ do (assert (or (not pos) (eql pos i))) ++ do (let ((byte (read-byte is))) ++ (assert (eql byte (logand (1- n) i))))))) ++ nil) ++ ++(deftest file-position.8 ++ (loop for len from 33 to 100 ++ for n = (ash 1 len) ++ do (with-open-file ++ (os "tmp.dat" :direction :output ++ :if-exists :supersede ++ :element-type `(unsigned-byte ,len)) ++ (loop for i from 0 below 100 ++ for r = (logand (1- n) i) ++ for pos = (file-position os) ++ do (assert (or (not pos) (eql pos i))) ++ do (write-byte r os))) ++ do (with-open-file ++ (is "tmp.dat" :direction :input ++ :element-type `(unsigned-byte ,len)) ++ (loop for i from 0 below 100 ++ for pos = (file-position is) ++ do (assert (or (not pos) (eql pos i))) ++ do (let ((byte (read-byte is))) ++ (assert (eql byte (logand (1- n) i))))))) ++ nil) ++ ++(deftest file-position.9 ++ (with-input-from-string ++ (s "abcdefghijklmnopqrstuvwxyz") ++ (loop repeat 26 ++ for p = (file-position s) ++ unless (or (not p) ++ (progn ++ (file-position s p) ++ (eql (file-position s) p))) ++ collect p ++ do (read-char s))) ++ nil) ++ ++(deftest file-position.10 ++ (with-output-to-string ++ (s) ++ (loop repeat 26 ++ for p = (file-position s) ++ unless (or (not p) ++ (progn ++ (file-position s p) ++ (eql (file-position s) p))) ++ collect p ++ do (write-char #\x s))) ++ "xxxxxxxxxxxxxxxxxxxxxxxxxx") ++ ++;;; Error tests ++ ++(deftest file-position.error.1 ++ (signals-error (file-position) program-error) ++ t) ++ ++(deftest file-position.error.2 ++ (signals-error ++ (file-position (make-string-input-stream "abc") :start nil) ++ program-error) ++ t) ++ ++;;; It's not clear what 'too large' means -- can we set the ++;;; file position to a point where the file may later be extended ++;;; by some other writer? ++#| ++(deftest file-position.error.3 ++ (signals-error ++ (with-open-file ++ (is "file-position.lsp" :direction :input) ++ (flet ((%fail () (error 'type-error))) ++ (unless (file-position is :end) (%fail)) ++ (let ((fp (file-position is))) ++ (unless fp (%fail)) ++ (file-position is (+ 1000000 fp))))) ++ error) ++ t) ++ ++(deftest file-position.error.4 ++ (signals-error ++ (with-open-file ++ (is "file-position.lsp" :direction :input) ++ (file-position is 1000000000000000000000)) ++ error) ++ t) ++|# ++ ++ +\ No newline at end of file +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-string-length.lsp +@@ -0,0 +1,73 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 22 21:34:04 2004 ++;;;; Contains: Tests of FILE-STRING-LENGTH ++ ++(in-package :cl-test) ++ ++(deftest file-string-length.1 ++ (with-open-file ++ (s "tmp.dat" :direction :output ++ :if-exists :supersede) ++ (loop for x across +standard-chars+ ++ for len = (file-string-length s x) ++ do (assert (typep len '(or null (integer 0)))) ++ do (let ((pos1 (file-position s))) ++ (write-char x s) ++ (let ((pos2 (file-position s))) ++ (when (and pos1 pos2 len) ++ (assert (= (+ pos1 len) pos2))))))) ++ nil) ++ ++(deftest file-string-length.2 ++ (with-open-file ++ (s "tmp.dat" :direction :output ++ :if-exists :supersede) ++ (loop for x across +standard-chars+ ++ for len = (file-string-length s (string x)) ++ do (assert (typep len '(or null (integer 0)))) ++ do (let ((pos1 (file-position s))) ++ (write-sequence (string x) s) ++ (let ((pos2 (file-position s))) ++ (when (and pos1 pos2 len) ++ (assert (= (+ pos1 len) pos2))))))) ++ nil) ++ ++(deftest file-string-length.3 ++ (with-open-file ++ (stream "tmp.dat" :direction :output ++ :if-exists :supersede) ++ (let* ((s1 "abcde") ++ (n (file-string-length stream s1))) ++ (do-special-strings ++ (s2 s1 nil) ++ (assert (= (file-string-length stream s2) n))))) ++ nil) ++ ++;;; Error tests ++ ++(deftest file-string-length.error.1 ++ (signals-error (file-string-length) program-error) ++ t) ++ ++(deftest file-string-length.error.2 ++ (signals-error ++ (with-open-file ++ (s "tmp.dat" :direction :output ++ :if-exists :supersede) ++ (file-string-length s)) ++ program-error) ++ t) ++ ++(deftest file-string-length.error.3 ++ (signals-error ++ (with-open-file ++ (s "tmp.dat" :direction :output ++ :if-exists :supersede) ++ (file-string-length s #\x nil)) ++ program-error) ++ t) ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/file-write-date.lsp +@@ -0,0 +1,89 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 6 06:01:35 2004 ++;;;; Contains: Tests for FILE-WRITE-DATE ++ ++(in-package :cl-test) ++ ++(deftest file-write-date.1 ++ (let* ((pn "file-write-date.lsp") ++ (date (file-write-date pn)) ++ (time (get-universal-time))) ++ (or (null date) ++ (and (integerp date) ++ (<= 0 date time) ++ t))) ++ t) ++ ++(deftest file-write-date.2 ++ (let* ((pn #p"file-write-date.lsp") ++ (date (file-write-date pn)) ++ (time (get-universal-time))) ++ (or (null date) ++ (and (integerp date) ++ (<= 0 date time) ++ t))) ++ t) ++ ++(deftest file-write-date.3 ++ (let* ((pn (truename "file-write-date.lsp")) ++ (date (file-write-date pn)) ++ (time (get-universal-time))) ++ (or (null date) ++ (and (integerp date) ++ (<= 0 date time) ++ t))) ++ t) ++ ++(deftest file-write-date.4 ++ (loop for pn in (directory ++ (make-pathname :name :wild :type :wild ++ :defaults *default-pathname-defaults*)) ++ for date = (file-write-date pn) ++ for time = (get-universal-time) ++ unless (or (null date) ++ (<= 0 date time)) ++ collect (list pn date time)) ++ nil) ++ ++(deftest file-write-date.5 ++ (length (multiple-value-list (file-write-date "file-write-date.lsp"))) ++ 1) ++ ++;;; Specialized string tests ++ ++(deftest file-write-date.6 ++ (let* ((str "file-write-date.lsp") ++ (date (file-write-date str))) ++ (do-special-strings ++ (s str nil) ++ (assert (equal (file-write-date s) date)))) ++ nil) ++ ++;;; FIXME ++;;; Add LPN test ++ ++;;; Error tests ++ ++(deftest file-write-date.error.1 ++ (signals-error (file-write-date) program-error) ++ t) ++ ++(deftest file-write-date.error.2 ++ (signals-error (file-write-date "file-write-date.lsp" nil) ++ program-error) ++ t) ++ ++(deftest file-write-date.error.3 ++ (signals-error-always ++ (file-write-date (make-pathname :name :wild :type "lsp" ++ :defaults *default-pathname-defaults*)) ++ file-error) ++ t t) ++ ++(deftest file-write-date.error.4 ++ (signals-error-always ++ (file-write-date (make-pathname :name "file-write-date" :type :wild ++ :defaults *default-pathname-defaults*)) ++ file-error) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/finish-output.lsp +@@ -0,0 +1,54 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 28 06:38:20 2004 ++;;;; Contains: Tests of FINISH-OUTPUT ++ ++(in-package :cl-test) ++ ++(deftest finish-output.1 ++ (finish-output) ++ nil) ++ ++(deftest finish-output.2 ++ (finish-output t) ++ nil) ++ ++(deftest finish-output.3 ++ (finish-output nil) ++ nil) ++ ++(deftest finish-output.4 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-output* *trace-output* *terminal-io*) ++ for results = (multiple-value-list (finish-output s)) ++ unless (equal results '(nil)) ++ collect s) ++ nil) ++ ++(deftest finish-output.5 ++ (let ((os (make-string-output-stream))) ++ (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") ++ os))) ++ (finish-output t))) ++ nil) ++ ++(deftest finish-output.6 ++ (let ((*standard-output* (make-string-output-stream))) ++ (finish-output nil)) ++ nil) ++ ++;;; Error tests ++ ++(deftest finish-output.error.1 ++ (signals-error (finish-output nil nil) program-error) ++ t) ++ ++(deftest finish-output.error.2 ++ (signals-error (finish-output t nil) program-error) ++ t) ++ ++(deftest finish-output.error.3 ++ (check-type-error #'finish-output ++ #'(lambda (x) (typep x '(or stream (member nil t))))) ++ nil) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/force-output.lsp +@@ -0,0 +1,56 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 28 06:41:46 2004 ++;;;; Contains: Tests of FORCE-OUTPUT ++ ++(in-package :cl-test) ++ ++(deftest force-output.1 ++ (force-output) ++ nil) ++ ++(deftest force-output.2 ++ (force-output t) ++ nil) ++ ++(deftest force-output.3 ++ (force-output nil) ++ nil) ++ ++(deftest force-output.4 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-output* *trace-output* *terminal-io*) ++ for results = (multiple-value-list (force-output s)) ++ unless (equal results '(nil)) ++ collect s) ++ nil) ++ ++(deftest force-output.5 ++ (let ((os (make-string-output-stream))) ++ (let ((*terminal-io* (make-two-way-stream (make-string-input-stream "") ++ os))) ++ (force-output t))) ++ nil) ++ ++(deftest force-output.6 ++ (let ((*standard-output* (make-string-output-stream))) ++ (force-output nil)) ++ nil) ++ ++ ++;;; Error tests ++ ++(deftest force-output.error.1 ++ (signals-error (force-output nil nil) program-error) ++ t) ++ ++(deftest force-output.error.2 ++ (signals-error (force-output t nil) program-error) ++ t) ++ ++(deftest force-output.error.3 ++ (check-type-error #'force-output ++ #'(lambda (x) (typep x '(or stream (member nil t))))) ++ nil) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/fresh-line.lsp +@@ -0,0 +1,87 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:41:18 2004 ++;;;; Contains: Tests of FRESH-LINE ++ ++(in-package :cl-test) ++ ++(deftest fresh-line.1 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (write-char #\a) ++ (setq result (notnot (fresh-line)))) ++ result)) ++ #.(concatenate 'string "a" (string #\Newline)) ++ t) ++ ++(deftest fresh-line.2 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (write-char #\a s) ++ (setq result (notnot (fresh-line s)))) ++ result)) ++ #.(concatenate 'string "a" (string #\Newline)) ++ t) ++ ++(deftest fresh-line.3 ++ (with-output-to-string ++ (s) ++ (write-char #\x s) ++ (fresh-line s) ++ (fresh-line s) ++ (write-char #\y s)) ++ #.(concatenate 'string "x" (string #\Newline) "y")) ++ ++(deftest fresh-line.4 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (fresh-line)))) ++ result)) ++ "" (nil)) ++ ++(deftest fresh-line.5 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (write-char #\Space s) ++ (setq result ++ (list ++ (multiple-value-list (notnot-mv (fresh-line s))) ++ (multiple-value-list (fresh-line s)) ++ (multiple-value-list (fresh-line s))))) ++ result)) ++ " ++" ((t) (nil) (nil))) ++ ++(deftest fresh-line.6 ++ (with-output-to-string ++ (os) ++ (let ((*terminal-io* (make-two-way-stream *standard-input* os))) ++ (write-char #\a t) ++ (fresh-line t) ++ (finish-output t))) ++ #.(concatenate 'string (string #\a) (string #\Newline))) ++ ++(deftest fresh-line.7 ++ (with-output-to-string ++ (*standard-output*) ++ (write-char #\a nil) ++ (terpri nil)) ++ #.(concatenate 'string (string #\a) (string #\Newline))) ++ ++;;; Error tests ++ ++(deftest fresh-line.error.1 ++ (signals-error ++ (with-output-to-string ++ (s) ++ (fresh-line s nil)) ++ program-error) ++ t) +--- gcl-2.6.12.orig/ansi-tests/gclload2.lsp ++++ gcl-2.6.12/ansi-tests/gclload2.lsp +@@ -46,6 +46,15 @@ + ;;; Tests of strings + (load "load-strings.lsp") + ++;;; Tests of pathnames ++(load "load-pathnames.lsp") ++ ++;;; Tests of file operations ++(load "load-files.lsp") ++ ++;;; Tests of streams ++(load "load-streams.lsp") ++ + ;;; Tests for character functions + (compile-and-load "char-aux.lsp") + (load "character.lsp") +--- /dev/null ++++ gcl-2.6.12/ansi-tests/get-output-stream-string.lsp +@@ -0,0 +1,32 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 09:48:46 2004 ++;;;; Contains: Tests of GET-OUTPUT-STREAM-STRING ++ ++(in-package :cl-test) ++ ++;; this function is used extensively elsewhere in the test suite ++ ++(deftest get-output-stream-string.1 ++ (let ((s (make-string-output-stream))) ++ (values ++ (get-output-stream-string s) ++ (write-string "abc" s) ++ (write-string "def" s) ++ (get-output-stream-string s) ++ (get-output-stream-string s))) ++ "" "abc" "def" "abcdef" "") ++ ++;;; Error cases ++ ++(deftest get-output-stream-string.error.1 ++ (signals-error (get-output-stream-string) t) ++ t) ++ ++(deftest get-output-stream-string.error.2 ++ (signals-error (get-output-stream-string (make-string-output-stream) nil) t) ++ t) ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/host-namestring.lsp +@@ -0,0 +1,49 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Sep 12 06:22:40 2004 ++;;;; Contains: Tests of HOST-NAMESTRING ++ ++(in-package :cl-test) ++ ++(deftest host-namestring.1 ++ (let* ((vals (multiple-value-list ++ (host-namestring "host-namestring.lsp"))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (or (null s) ++ (stringp s) ++ ;; (equal (host-namestring s) s) ++ )) ++ :good ++ vals)) ++ :good) ++ ++(deftest host-namestring.2 ++ (do-special-strings ++ (s "host-namestring.lsp" nil) ++ (let ((ns (host-namestring s))) ++ (when ns ++ (assert (stringp ns)) ++ ;; (assert (string= (host-namestring ns) ns)) ++ ))) ++ nil) ++ ++(deftest host-namestring.3 ++ (let* ((name "host-namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (with-open-file (s pn :direction :input) ++ (host-namestring s))) ++ (name3 (host-namestring pn))) ++ (or (equalt name2 name3) (list name2 name3))) ++ t) ++ ++;;; Error tests ++ ++(deftest host-namestring.error.1 ++ (signals-error (host-namestring) program-error) ++ t) ++ ++(deftest host-namestring.error.2 ++ (signals-error (host-namestring "host-namestring.lsp" nil) program-error) ++ t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/input-stream-p.lsp +@@ -0,0 +1,40 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:39:27 2004 ++;;;; Contains: Tests for INPUT-STREAM-P ++ ++(in-package :cl-test) ++ ++(deftest input-stream-p.1 ++ (notnot-mv (input-stream-p *standard-input*)) ++ t) ++ ++(deftest input-stream-p.2 ++ (notnot-mv (input-stream-p *terminal-io*)) ++ t) ++ ++(deftest input-stream-p.3 ++ (with-open-file (s "input-stream-p.lsp" :direction :input) ++ (notnot-mv (input-stream-p s))) ++ t) ++ ++(deftest input-stream-p.4 ++ (with-open-file (s "foo.txt" :direction :output ++ :if-exists :supersede) ++ (input-stream-p s)) ++ nil) ++ ++;;; Error tests ++ ++(deftest input-stream-p.error.1 ++ (signals-error (input-stream-p) program-error) ++ t) ++ ++(deftest input-stream-p.error.2 ++ (signals-error (input-stream-p *standard-input* nil) ++ program-error) ++ t) ++ ++(deftest input-stream-p.error.3 ++ (check-type-error #'input-stream-p #'streamp) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/interactive-stream-p.lsp +@@ -0,0 +1,28 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:47:59 2004 ++;;;; Contains: Tests of INTERACTIVE-STREAM-P ++ ++(in-package :cl-test) ++ ++(deftest interactive-stream-p.1 ++ (let ((streams (list *debug-io* *error-output* *query-io* ++ *standard-input* *standard-output* ++ *trace-output* *terminal-io*))) ++ (mapc #'interactive-stream-p streams) ++ ;; no error should occur ++ nil) ++ nil) ++ ++(deftest interactive-stream-p.error.1 ++ (check-type-error #'interactive-stream-p #'streamp) ++ nil) ++ ++(deftest interactive-stream-p.error.2 ++ (signals-error (interactive-stream-p) program-error) ++ t) ++ ++(deftest interactive-stream-p.error.3 ++ (signals-error (interactive-stream-p *terminal-io* nil) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/ldtest.lsp +@@ -0,0 +1 @@ ++(in-package :cl-test) (defun LOAD-TEST-FUN-3 () :foo) +\ No newline at end of file +--- /dev/null ++++ gcl-2.6.12/ansi-tests/listen.lsp +@@ -0,0 +1,73 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 27 21:16:39 2004 ++;;;; Contains: Tests of LISTEN ++ ++(in-package :cl-test) ++ ++(deftest listen.1 ++ (with-input-from-string (s "") (listen s)) ++ nil) ++ ++(deftest listen.2 ++ (with-input-from-string (s "x") (notnot-mv (listen s))) ++ t) ++ ++(deftest listen.3 ++ (with-input-from-string (*standard-input* "") (listen)) ++ nil) ++ ++(deftest listen.4 ++ (with-input-from-string (*standard-input* "A") (notnot-mv (listen))) ++ t) ++ ++;;; (deftest listen.5 ++;;; (when (interactive-stream-p *standard-input*) ++;;; (clear-input) (listen)) ++;;; nil) ++ ++(deftest listen.6 ++ (with-input-from-string ++ (s "x") ++ (values ++ (read-char s) ++ (listen s) ++ (unread-char #\x s) ++ (notnot (listen s)) ++ (read-char s))) ++ #\x nil nil t #\x) ++ ++(deftest listen.7 ++ (with-open-file ++ (s "listen.lsp") ++ (values ++ (notnot (listen s)) ++ (handler-case ++ (locally (declare (optimize safety)) ++ (loop (read-char s))) ++ (end-of-file () (listen s))))) ++ t nil) ++ ++(deftest listen.8 ++ (with-input-from-string ++ (is "abc") ++ (let ((*terminal-io* (make-two-way-stream is (make-broadcast-stream)))) ++ (notnot-mv (listen t)))) ++ t) ++ ++(deftest listen.9 ++ (with-input-from-string ++ (*standard-input* "345") ++ (notnot-mv (listen nil))) ++ t) ++ ++;;; Error tests ++ ++(deftest listen.error.1 ++ :notes (:assume-no-simple-streams) ++ (signals-error (listen *standard-input* nil) program-error) ++ t) ++ ++(deftest listen.error.2 ++ (signals-error (listen *standard-input* nil nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-files.lsp +@@ -0,0 +1,16 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 1 11:59:35 2004 ++;;;; Contains: Load tests of section 20, 'Files' ++ ++(in-package :cl-test) ++ ++(load "directory.lsp") ++(load "probe-file.lsp") ++(load "ensure-directories-exist.lsp") ++(load "truename.lsp") ++(load "file-author.lsp") ++(load "file-write-date.lsp") ++(load "rename-file.lsp") ++(load "delete-file.lsp") ++(load "file-error.lsp") +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-logical-pathname-translations.lsp +@@ -0,0 +1,34 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Dec 31 09:31:33 2003 ++;;;; Contains: Tests (such as they are) for LOAD-LOGICAL-PATHNAME-TRANSLATIONS ++ ++(in-package :cl-test) ++ ++;;; The function LOAD-LOGICAL-PATHNAME-TRANSLATIONS is almost entirely ++;;; untestable, since the basic behavior is implementation defined. ++ ++(deftest load-logical-pathname-translations.1 ++ (load-logical-pathname-translations "CLTESTROOT") ++ nil) ++ ++;;; Error cases ++ ++(deftest load-logical-pathname-translations.error.1 ++ (handler-case ++ (progn (load-logical-pathname-translations ++ "THEREHADBETTERNOTBEAHOSTCALLEDTHIS") ++ nil) ++ (error () :good)) ++ :good) ++ ++(deftest load-logical-pathname-translations.error.2 ++ (signals-error (load-logical-pathname-translations) ++ program-error) ++ t) ++ ++(deftest load-logical-pathname-translations.error.3 ++ (signals-error (load-logical-pathname-translations "CLTESTROOT" nil) ++ program-error) ++ t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-pathnames.lsp +@@ -0,0 +1,36 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Nov 29 04:33:05 2003 ++;;;; Contains: Load tests for pathnames and logical pathnames ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(load "pathnames.lsp") ++(load "pathname.lsp") ++(load "pathnamep.lsp") ++(load "make-pathname.lsp") ++(load "pathname-host.lsp") ++(load "pathname-device.lsp") ++(load "pathname-directory.lsp") ++(load "pathname-name.lsp") ++(load "pathname-type.lsp") ++(load "pathname-version.lsp") ++ ++(load "load-logical-pathname-translations.lsp") ++(load "logical-pathname.lsp") ++(load "logical-pathname-translations.lsp") ++(load "translate-logical-pathname.lsp") ++ ++(load "namestring.lsp") ++(load "file-namestring.lsp") ++(load "directory-namestring.lsp") ++(load "host-namestring.lsp") ++(load "enough-namestring.lsp") ++ ++(load "wild-pathname-p.lsp") ++(load "merge-pathnames.lsp") ++(load "pathname-match-p.lsp") ++ ++(load "parse-namestring.lsp") +\ No newline at end of file +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-streams.lsp +@@ -0,0 +1,57 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:38:10 2004 ++;;;; Contains: Load files containing tests for section 21 (streams) ++ ++(in-package :cl-test) ++ ++(load "input-stream-p.lsp") ++(load "output-stream-p.lsp") ++(load "interactive-stream-p.lsp") ++(load "open-stream-p.lsp") ++(load "stream-element-type.lsp") ++(load "streamp.lsp") ++(load "read-byte.lsp") ++(load "peek-char.lsp") ++(load "read-char.lsp") ++(load "read-char-no-hang.lsp") ++(load "terpri.lsp") ++(load "fresh-line.lsp") ++(load "unread-char.lsp") ++(load "write-char.lsp") ++(load "read-line.lsp") ++(load "write-string.lsp") ++(load "write-line.lsp") ++(load "read-sequence.lsp") ++(load "write-sequence.lsp") ++(load "file-length.lsp") ++(load "file-position.lsp") ++(load "file-string-length.lsp") ++(load "open.lsp") ++(load "stream-external-format.lsp") ++(load "with-open-file.lsp") ++(load "with-open-stream.lsp") ++(load "listen.lsp") ++(load "clear-input.lsp") ++(load "finish-output.lsp") ++(load "force-output.lsp") ++(load "clear-output.lsp") ++(load "make-synonym-stream.lsp") ++(load "synonym-stream-symbol.lsp") ++(load "make-broadcast-stream.lsp") ++(load "broadcast-stream-streams.lsp") ++(load "make-two-way-stream.lsp") ++(load "two-way-stream-input-stream.lsp") ++(load "two-way-stream-output-stream.lsp") ++(load "echo-stream-input-stream.lsp") ++(load "echo-stream-output-stream.lsp") ++(load "make-echo-stream.lsp") ++(load "concatenated-stream-streams.lsp") ++(load "make-concatenated-stream.lsp") ++(load "get-output-stream-string.lsp") ++(load "make-string-input-stream.lsp") ++(load "make-string-output-stream.lsp") ++(load "with-input-from-string.lsp") ++(load "with-output-to-string.lsp") ++(load "stream-error-stream.lsp") ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-system-construction.lsp +@@ -0,0 +1,12 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Dec 12 19:44:29 2004 ++;;;; Contains: Load tests for system construction (section 24) ++ ++(in-package :cl-test) ++ ++(load "compile-file.lsp") ++(load "load.lsp") ++(load "with-compilation-unit.lsp") ++(load "features.lsp") ++(load "modules.lsp") +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-test-file-2.lsp +@@ -0,0 +1,7 @@ ++(in-package :cl-test) ++ ++(declaim (special *load-test-var.1* *load-test-var.2*)) ++(eval-when (:load-toplevel) ++ (setq *load-test-var.1* *load-pathname*) ++ (setq *load-test-var.2* *load-truename*)) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/load-test-file.lsp +@@ -0,0 +1,9 @@ ++(in-package :cl-test) ++ ++(defun load-file-test-fun.1 () ++ '#.*load-pathname*) ++ ++(defun load-file-test-fun.2 () ++ '#.*load-truename*) ++ ++ +--- gcl-2.6.12.orig/ansi-tests/load.lsp ++++ gcl-2.6.12/ansi-tests/load.lsp +@@ -1,15 +1,227 @@ +-;; Get the MK package +-;; I've hardwired a path here; fix for your system +-;; I assume the package is already compiled. +-(unless (find-package "MK") +- (load #.(concatenate 'string "../defsys30/defsystem." +- #+cmu (C::BACKEND-FASL-FILE-TYPE C::*TARGET-BACKEND*) +- #+allegro "fasl" +- #+(or akcl gcl) "o"))) +- +-(load "rt/rt.system") +-(mk::load-system "rt") +-(mk::compile-system "cltest") ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Apr 12 21:51:49 2005 ++;;;; Contains: Tests of LOAD ++ + (in-package :cl-test) + ++(defun load-file-test (file funname &rest args &key ++ if-does-not-exist ++ (print nil print-p) ++ (verbose nil verbose-p) ++ (*load-print* nil) ++ (*load-verbose* nil) ++ external-format) ++ (declare (ignorable external-format if-does-not-exist ++ print print-p verbose verbose-p)) ++ (fmakunbound funname) ++ (let* ((str (make-array '(0) :element-type 'character :adjustable t ++ :fill-pointer 0)) ++ (vals (multiple-value-list ++ (with-output-to-string ++ (*standard-output* str) ++ (apply #'load file :allow-other-keys t args)))) ++ (print? (if print-p print *load-print*)) ++ (verbose? (if verbose-p verbose *load-verbose*))) ++ (values ++ (let ((v1 (car vals)) ++ (v2 (or (and verbose-p (not verbose)) ++ (and (not verbose-p) (not *load-verbose*)) ++ (position #\; str))) ++ (v3 (or (and print-p (not print)) ++ (and (not print-p) (not *load-print*)) ++ (> (length str) 0))) ++ (v4 (if (or print? verbose?) ++ (> (length str) 0) ++ t))) ++ (if (and (= (length vals) 1) v1 v2 v3 v4) t (list vals v2 v3 v4 str))) ++ (funcall funname)))) ++ ++(deftest load.1 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1) ++ t nil) ++ ++(deftest load.2 ++ (load-file-test #p"compile-file-test-file.lsp" 'compile-file-test-fun.1) ++ t nil) ++ ++(deftest load.3 ++ (with-input-from-string ++ (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") ++ (load-file-test s 'load-file-test-fun.2)) ++ t good) ++ ++(deftest load.4 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :external-format :default) ++ t nil) ++ ++(deftest load.5 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :verbose t) ++ t nil) ++ ++(deftest load.6 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :*load-verbose* t) ++ t nil) ++ ++(deftest load.7 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :*load-verbose* t :verbose nil) ++ t nil) ++ ++(deftest load.8 ++ (with-input-from-string ++ (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") ++ (load-file-test s 'load-file-test-fun.2 :verbose t)) ++ t good) ++ ++(deftest load.9 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :print t) ++ t nil) ++ ++(deftest load.10 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :*load-print* t) ++ t nil) ++ ++(deftest load.11 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :*load-print* t :print nil) ++ t nil) ++ ++(deftest load.12 ++ (load-file-test "compile-file-test-file.lsp" 'compile-file-test-fun.1 ++ :*load-print* nil :print t) ++ t nil) ++ ++(deftest load.13 ++ (with-input-from-string ++ (s "(in-package :cl-test) (defun load-file-test-fun.2 () 'good)") ++ (load-file-test s 'load-file-test-fun.2 :print t)) ++ t good) ++ ++(deftest load.14 ++ (load "nonexistent-file.lsp" :if-does-not-exist nil) ++ nil) ++ ++(defpackage LOAD-TEST-PACKAGE (:use "COMMON-LISP")) ++ ++(deftest load.15 ++ (let ((*package* (find-package "LOAD-TEST-PACKAGE"))) ++ (with-input-from-string ++ (s "(defun f () 'good)") ++ (load-file-test s 'load-test-package::f))) ++ t load-test-package::good) ++ ++(deftest load.15a ++ (let ((*package* (find-package "CL-TEST"))) ++ (values ++ (with-input-from-string ++ (s "(eval-when (:load-toplevel :execute) (setq *package* (find-package \"LOAD-TEST-PACKAGE\"))) ++ (defun f () 'good)") ++ (multiple-value-list (load-file-test s 'load-test-package::f))) ++ (read-from-string "GOOD"))) ++ (t load-test-package::good) good) ++ ++(deftest load.16 ++ (let ((*readtable* (copy-readtable nil))) ++ (set-macro-character #\! (get-macro-character #\')) ++ (with-input-from-string ++ (s "(in-package :cl-test) (defun load-file-test-fun.3 () !good)") ++ (load-file-test s 'load-file-test-fun.3))) ++ t good) ++ ++(deftest load.16a ++ (let ((*readtable* *readtable*) ++ (*package* (find-package "CL-TEST"))) ++ (values ++ (with-input-from-string ++ (s "(in-package :cl-test) ++ (eval-when (:load-toplevel :execute) ++ (setq *readtable* (copy-readtable nil)) ++ (set-macro-character #\\! (get-macro-character #\\'))) ++ (defun load-file-test-fun.3 () !good)") ++ (multiple-value-list ++ (load-file-test s 'load-file-test-fun.3))) ++ (read-from-string "!FOO"))) ++ (t good) !FOO) ++ ++(deftest load.17 ++ (let ((file #p"load-test-file.lsp")) ++ (fmakunbound 'load-file-test-fun.1) ++ (fmakunbound 'load-file-test-fun.2) ++ (values ++ (notnot (load file)) ++ (let ((p1 (pathname (merge-pathnames file))) ++ (p2 (funcall 'load-file-test-fun.1))) ++ (equalpt-or-report p1 p2)) ++ (let ((p1 (truename file)) ++ (p2 (funcall 'load-file-test-fun.2))) ++ (equalpt-or-report p1 p2)))) ++ t t t) ++ ++;;; Test that the load pathname/truename variables are bound ++;;; properly when loading compiled files ++ ++(deftest load.18 ++ (let* ((file "load-test-file-2.lsp") ++ (target (enough-namestring (compile-file-pathname file)))) ++ (declare (special *load-test-var.1* *load-test-var.2*)) ++ (compile-file file) ++ (makunbound '*load-test-var.1*) ++ (makunbound '*load-test-var.2*) ++ (load target) ++ (values ++ (let ((p1 (pathname (merge-pathnames target))) ++ (p2 *load-test-var.1*)) ++ (equalpt-or-report p1 p2)) ++ (let ((p1 (truename target)) ++ (p2 *load-test-var.2*)) ++ (equalpt-or-report p1 p2)))) ++ t t) ++ ++(deftest load.19 ++ (let ((file (logical-pathname "CLTEST:LDTEST.LSP")) ++ (fn 'load-test-fun-3) ++ (*package* (find-package "CL-TEST"))) ++ (with-open-file ++ (s file :direction :output :if-exists :supersede ++ :if-does-not-exist :create) ++ (format s "(in-package :cl-test) (defun ~a () :foo)" fn)) ++ (fmakunbound fn) ++ (values ++ (notnot (load file)) ++ (funcall fn))) ++ t :foo) ++ ++;;; Defaults of the load variables ++ ++(deftest load-pathname.1 ++ *load-pathname* ++ nil) ++ ++(deftest load-truename.1 ++ *load-truename* ++ nil) ++ ++(deftest load-print.1 ++ *load-print* ++ nil) ++ ++;;; Error tests ++ ++(deftest load.error.1 ++ (signals-error (load "nonexistent-file.lsp") file-error) ++ t) ++ ++(deftest load.error.2 ++ (signals-error (load) program-error) ++ t) + ++(deftest load.error.3 ++ (signals-error (load "compile-file-test-file.lsp" :bad-key-arg t) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/logical-pathname-translations.lsp +@@ -0,0 +1,8 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Dec 31 09:46:08 2003 ++;;;; Contains: Tests of LOGICAL-PATHNAME-TRANSLATIONS ++ ++(in-package :cl-test) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/logical-pathname.lsp +@@ -0,0 +1,93 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Dec 30 19:05:01 2003 ++;;;; Contains: Tests of LOGICAL-PATHNAME ++ ++(in-package :cl-test) ++ ++(deftest logical-pathname.1 ++ (loop for x in *logical-pathnames* ++ always (eql x (logical-pathname x))) ++ t) ++ ++(deftest logical-pathname.2 ++ (notnot-mv (typep (logical-pathname "CLTEST:FOO") 'logical-pathname)) ++ t) ++ ++(deftest logical-pathname.3 ++ (let ((name "CLTEST:TEMP.DAT.NEWEST")) ++ (with-open-file ++ (s (logical-pathname name) ++ :direction :output ++ :if-exists :supersede ++ :if-does-not-exist :create) ++ (or (equalt (logical-pathname s) (logical-pathname name)) ++ (list (logical-pathname s) (logical-pathname name))))) ++ t) ++ ++ ++;;; Error tests ++ ++(deftest logical-pathname.error.1 ++ (check-type-error #'logical-pathname ++ (typef '(or string stream logical-pathname))) ++ nil) ++ ++(deftest logical-pathname.error.2 ++ ;; Doesn't specify a host ++ (signals-error (logical-pathname "FOO.TXT") type-error) ++ t) ++ ++(deftest logical-pathname.error.3 ++ (signals-error ++ (with-open-file (s #p"logical-pathname.lsp" :direction :input) ++ (logical-pathname s)) ++ type-error) ++ t) ++ ++(deftest logical-pathname.error.4 ++ (signals-error ++ (with-open-stream ++ (is (make-concatenated-stream)) ++ (with-open-stream ++ (os (make-broadcast-stream)) ++ (with-open-stream ++ (s (make-two-way-stream is os)) ++ (logical-pathname s)))) ++ type-error) ++ t) ++ ++(deftest logical-pathname.error.5 ++ (signals-error ++ (with-open-stream ++ (is (make-concatenated-stream)) ++ (with-open-stream ++ (os (make-broadcast-stream)) ++ (with-open-stream ++ (s (make-echo-stream is os)) ++ (logical-pathname s)))) ++ type-error) ++ t) ++ ++(deftest logical-pathname.error.6 ++ (signals-error (with-open-stream (s (make-broadcast-stream)) (logical-pathname s)) type-error) ++ t) ++ ++(deftest logical-pathname.error.7 ++ (signals-error (with-open-stream (s (make-concatenated-stream)) (logical-pathname s)) type-error) ++ t) ++ ++(deftest logical-pathname.error.8 ++ (signals-error (with-open-stream (s (make-string-input-stream "foo")) ++ (logical-pathname s)) type-error) ++ t) ++ ++(deftest logical-pathname.error.9 ++ (signals-error (with-output-to-string (s) (logical-pathname s)) type-error) ++ t) ++ ++(deftest logical-pathname.error.10 ++ (handler-case ++ (progn (eval '(locally (declare (optimize safety)) (logical-pathname "CLROOT:%"))) t) ++ (type-error () t)) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-broadcast-stream.lsp +@@ -0,0 +1,99 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 29 21:28:25 2004 ++;;;; Contains: Tests of MAKE-BROADCAST-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-broadcast-stream.1 ++ (let ((s (make-broadcast-stream))) ++ (assert (typep s 'stream)) ++ (assert (typep s 'broadcast-stream)) ++ (assert (output-stream-p s)) ++ ;; (assert (not (input-stream-p s))) ++ (assert (open-stream-p s)) ++ (assert (streamp s)) ++ ;; (assert (eq (stream-element-type s) t)) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'broadcast-stream)) ++ (notnot (output-stream-p s)) ++ (progn (write-char #\x s) nil) ++ )) ++ t t t nil) ++ ++(deftest make-broadcast-stream.2 ++ (with-output-to-string ++ (s1) ++ (let ((s (make-broadcast-stream s1))) ++ (assert (typep s 'stream)) ++ (assert (typep s 'broadcast-stream)) ++ (assert (output-stream-p s)) ++ ;; (assert (not (input-stream-p s))) ++ (assert (open-stream-p s)) ++ (assert (streamp s)) ++ (assert (eql (stream-element-type s) ++ (stream-element-type s1))) ++ (write-char #\x s))) ++ "x") ++ ++(deftest make-broadcast-stream.3 ++ (let ((s1 (make-string-output-stream)) ++ (s2 (make-string-output-stream))) ++ (let ((s (make-broadcast-stream s1 s2))) ++ (assert (typep s 'stream)) ++ (assert (typep s 'broadcast-stream)) ++ (assert (output-stream-p s)) ++ ;; (assert (not (input-stream-p s))) ++ (assert (open-stream-p s)) ++ (assert (streamp s)) ++ (assert (eql (stream-element-type s) ++ (stream-element-type s2))) ++ (format s "This is a test")) ++ (values ++ (get-output-stream-string s1) ++ (get-output-stream-string s2))) ++ "This is a test" ++ "This is a test") ++ ++(deftest make-broadcast-stream.4 ++ (fresh-line (make-broadcast-stream)) ++ nil) ++ ++(deftest make-broadcast-stream.5 ++ (file-length (make-broadcast-stream)) ++ 0) ++ ++(deftest make-broadcast-stream.6 ++ (file-position (make-broadcast-stream)) ++ 0) ++ ++(deftest make-broadcast-stream.7 ++ (file-string-length (make-broadcast-stream) "antidisestablishmentarianism") ++ 1) ++ ++(deftest make-broadcast-stream.8 ++ (stream-external-format (make-broadcast-stream)) ++ :default) ++ ++ ++ ++;;; FIXME ++;;; Add tests for: close, ++;;; peek-char, read-char-no-hang, terpri, fresh-line, unread-char, ++;;; read-line, write-line, write-string, read-sequence, write-sequence, ++;;; read-byte, write-byte, listen, clear-input, finish-output, force-output, ++;;; clear-output, print, prin1 princ ++ ++;;; Error tests ++ ++(deftest make-broadcast-stream.error.1 ++ (check-type-error #'make-broadcast-stream ++ #'(lambda (x) (and (streamp x) (output-stream-p x)))) ++ nil) ++ ++(deftest make-broadcast-stream.error.2 ++ (check-type-error #'make-broadcast-stream ++ #'(lambda (x) (and (streamp x) (output-stream-p x))) ++ *streams*) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-concatenated-stream.lsp +@@ -0,0 +1,323 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 08:41:18 2004 ++;;;; Contains: Tests of MAKE-CONCATENATED-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-concatenated-stream.1 ++ (let ((s (make-concatenated-stream))) ++ (read s nil :eof)) ++ :eof) ++ ++(deftest make-concatenated-stream.2 ++ (let ((s (make-concatenated-stream))) ++ (notnot-mv (input-stream-p s))) ++ t) ++ ++(deftest make-concatenated-stream.3 ++ (let ((s (make-concatenated-stream))) ++ (output-stream-p s)) ++ nil) ++ ++(deftest make-concatenated-stream.4 ++ (let ((s (make-concatenated-stream))) ++ (notnot-mv (streamp s))) ++ t) ++ ++(deftest make-concatenated-stream.5 ++ (let ((s (make-concatenated-stream))) ++ (notnot-mv (typep s 'stream))) ++ t) ++ ++(deftest make-concatenated-stream.6 ++ (let ((s (make-concatenated-stream))) ++ (notnot-mv (typep s 'concatenated-stream))) ++ t) ++ ++(deftest make-concatenated-stream.7 ++ (let ((s (make-concatenated-stream))) ++ (notnot-mv (open-stream-p s))) ++ t) ++ ++(deftest make-concatenated-stream.8 ++ (let ((s (make-concatenated-stream *standard-input*))) ++ (notnot-mv (stream-element-type s))) ++ t) ++ ++(deftest make-concatenated-stream.9 ++ (let ((pn #p"tmp.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (s pn :direction :output :element-type element-type ++ :if-exists :supersede) ++ (dolist (b '(1 5 9 13)) (write-byte b s))) ++ (with-open-file ++ (s1 pn :direction :input :element-type element-type) ++ (with-open-file ++ (s2 pn :direction :input :element-type element-type) ++ (let ((s (make-concatenated-stream s1 s2))) ++ (loop repeat 8 collect (read-byte s)))))) ++ (1 5 9 13 1 5 9 13)) ++ ++(deftest make-concatenated-stream.10 ++ (let ((s (make-concatenated-stream))) ++ (read-byte s nil :eof)) ++ :eof) ++ ++(deftest make-concatenated-stream.11 ++ (let ((s (make-concatenated-stream))) ++ (peek-char nil s nil :eof)) ++ :eof) ++ ++(deftest make-concatenated-stream.12 ++ (with-input-from-string ++ (s1 "a") ++ (with-input-from-string ++ (s2 "b") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (values ++ (peek-char nil s) ++ (read-char s) ++ (peek-char nil s) ++ (read-char s) ++ (peek-char nil s nil :eof))))) ++ #\a #\a #\b #\b :eof) ++ ++(deftest make-concatenated-stream.13 ++ (with-input-from-string ++ (s1 " a ") ++ (with-input-from-string ++ (s2 " b ") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (values ++ (peek-char t s) ++ (read-char s) ++ (peek-char t s) ++ (read-char s) ++ (peek-char t s nil :eof))))) ++ #\a #\a #\b #\b :eof) ++ ++(deftest make-concatenated-stream.14 ++ (with-input-from-string ++ (s1 "a") ++ (with-input-from-string ++ (s2 "b") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (values ++ (read-char s) ++ (unread-char #\a s) ++ (read-char s) ++ (read-char s) ++ (unread-char #\b s) ++ (read-char s) ++ (read-char s nil :eof))))) ++ #\a nil #\a #\b nil #\b :eof) ++ ++(deftest make-concatenated-stream.15 ++ (let ((s (make-concatenated-stream))) ++ (read-char-no-hang s nil :eof)) ++ :eof) ++ ++(deftest make-concatenated-stream.16 ++ (with-input-from-string ++ (s1 "a") ++ (with-input-from-string ++ (s2 "b") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (values ++ (read-char-no-hang s) ++ (read-char-no-hang s) ++ (read-char-no-hang s nil :eof))))) ++ #\a #\b :eof) ++ ++(deftest make-concatenated-stream.17 ++ (with-input-from-string ++ (s1 "a") ++ (with-input-from-string ++ (s2 "b") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (multiple-value-bind (str mnp) ++ (read-line s) ++ (values str (notnot mnp)))))) ++ "ab" t) ++ ++(deftest make-concatenated-stream.18 ++ (with-input-from-string ++ (s1 "ab") ++ (with-input-from-string ++ (s2 "") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (multiple-value-bind (str mnp) ++ (read-line s) ++ (values str (notnot mnp)))))) ++ "ab" t) ++ ++(deftest make-concatenated-stream.19 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "ab") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (multiple-value-bind (str mnp) ++ (read-line s) ++ (values str (notnot mnp)))))) ++ "ab" t) ++ ++(deftest make-concatenated-stream.20 ++ (with-input-from-string ++ (s1 "ab") ++ (with-input-from-string ++ (s2 (concatenate 'string (string #\Newline) "def")) ++ (let ((s (make-concatenated-stream s1 s2))) ++ (read-line s)))) ++ "ab" nil) ++ ++(deftest make-concatenated-stream.21 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (multiple-value-bind (str mnp) ++ (read-line s nil :eof) ++ (values str (notnot mnp)))))) ++ :eof t) ++ ++(deftest make-concatenated-stream.22 ++ (let ((pn #p"tmp.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (s pn :direction :output :element-type element-type ++ :if-exists :supersede) ++ (dolist (b '(1 5 9 13)) (write-byte b s))) ++ (with-open-file ++ (s1 pn :direction :input :element-type element-type) ++ (with-open-file ++ (s2 pn :direction :input :element-type element-type) ++ (let ((s (make-concatenated-stream s1 s2)) ++ (x (vector nil nil nil nil nil nil nil nil))) ++ (values ++ (read-sequence x s) ++ x))))) ++ 8 ++ #(1 5 9 13 1 5 9 13)) ++ ++(deftest make-concatenated-stream.23 ++ (let ((pn #p"tmp.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (s pn :direction :output :element-type element-type ++ :if-exists :supersede) ++ (dolist (b '(1 5 9 13)) (write-byte b s))) ++ (with-open-file ++ (s1 pn :direction :input :element-type element-type) ++ (with-open-file ++ (s2 pn :direction :input :element-type element-type) ++ (let ((s (make-concatenated-stream s1 s2)) ++ (x (vector nil nil nil nil nil nil))) ++ (values ++ (read-sequence x s) ++ x))))) ++ 6 ++ #(1 5 9 13 1 5)) ++ ++(deftest make-concatenated-stream.24 ++ (let ((pn #p"tmp.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (s pn :direction :output :element-type element-type ++ :if-exists :supersede) ++ (dolist (b '(1 5 9 13)) (write-byte b s))) ++ (with-open-file ++ (s1 pn :direction :input :element-type element-type) ++ (with-open-file ++ (s2 pn :direction :input :element-type element-type) ++ (let ((s (make-concatenated-stream s1 s2)) ++ (x (vector nil nil nil nil nil nil nil nil nil nil))) ++ (values ++ (read-sequence x s) ++ x))))) ++ 8 ++ #(1 5 9 13 1 5 9 13 nil nil)) ++ ++(deftest make-concatenated-stream.25 ++ (close (make-concatenated-stream)) ++ t) ++ ++(deftest make-concatenated-stream.26 ++ (let ((s (make-concatenated-stream))) ++ (values (prog1 (close s) (close s)) ++ (open-stream-p s))) ++ t nil) ++ ++(deftest make-concatenated-stream.27 ++ (with-input-from-string ++ (s1 "abc") ++ (let ((s (make-concatenated-stream s1))) ++ (values ++ (notnot (open-stream-p s1)) ++ (notnot (open-stream-p s)) ++ (close s) ++ (notnot (open-stream-p s1)) ++ (open-stream-p s)))) ++ t t t t nil) ++ ++(deftest make-concatenated-stream.28 ++ (with-input-from-string ++ (s1 "a") ++ (let ((s (make-concatenated-stream s1))) ++ (notnot-mv (listen s)))) ++ t) ++ ++(deftest make-concatenated-stream.28a ++ (listen (make-concatenated-stream)) ++ nil) ++ ++(deftest make-concatenated-stream.29 ++ (with-input-from-string ++ (s1 "") ++ (let ((s (make-concatenated-stream s1))) ++ (listen s))) ++ nil) ++ ++(deftest make-concatenated-stream.30 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "a") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (notnot-mv (listen s))))) ++ t) ++ ++(deftest make-concatenated-stream.31 ++ (with-input-from-string ++ (s1 "") ++ (with-input-from-string ++ (s2 "") ++ (let ((s (make-concatenated-stream s1 s2))) ++ (listen s)))) ++ nil) ++ ++(deftest make-concatenated-stream.32 ++ (clear-input (make-concatenated-stream)) ++ nil) ++ ++(deftest make-concatenated-stream.33 ++ (with-input-from-string ++ (s1 "abc") ++ (clear-input (make-concatenated-stream s1))) ++ nil) ++ ++;;; Error cases ++ ++(deftest make-concatenated-stream.error.1 ++ (loop for x in *mini-universe* ++ unless (or (and (streamp x) (input-stream-p x)) ++ (eval `(signals-error (make-concatenated-stream ',x) t))) ++ collect x) ++ nil) ++ ++(deftest make-concatenated-stream.error.2 ++ (loop for x in *streams* ++ unless (or (and (streamp x) (input-stream-p x)) ++ (eval `(signals-error (make-concatenated-stream ',x) t))) ++ collect x) ++ nil) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-echo-stream.lsp +@@ -0,0 +1,332 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Feb 12 04:34:42 2004 ++;;;; Contains: Tests of MAKE-ECHO-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-echo-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (read-char s) ++ (get-output-stream-string os))) ++ #\f "f") ++ ++(deftest make-echo-stream.2 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (get-output-stream-string os)) ++ "") ++ ++(deftest make-echo-stream.3 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values (read-line s nil) ++ (get-output-stream-string os))) ++ "foo" "foo") ++ ++;;; Tests of READ-BYTE on echo streams ++ ++(deftest make-echo-stream.4 ++ (let ((pn #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (os pn ++ :direction :output ++ :element-type element-type ++ :if-exists :supersede) ++ (loop for x in '(2 3 5 7 11) ++ do (write-byte x os))) ++ (with-open-file ++ (is pn :direction :input :element-type element-type) ++ (values ++ (with-open-file ++ (os pn2 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (let ((s (make-echo-stream is os))) ++ (loop repeat 6 collect (read-byte s nil :eof1)))) ++ (with-open-file ++ (s pn2 :direction :input :element-type element-type) ++ (loop repeat 6 collect (read-byte s nil :eof2)))))) ++ (2 3 5 7 11 :eof1) ++ (2 3 5 7 11 :eof2)) ++ ++(deftest make-echo-stream.5 ++ (let ((pn #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (os pn ++ :direction :output ++ :element-type element-type ++ :if-exists :supersede) ++ (loop for x in '(2 3 5 7 11) ++ do (write-byte x os))) ++ (with-open-file ++ (is pn :direction :input :element-type element-type) ++ (values ++ (with-open-file ++ (os pn2 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (let ((s (make-echo-stream is os))) ++ (loop repeat 6 collect (read-byte s nil 100)))) ++ (with-open-file ++ (s pn2 :direction :input :element-type element-type) ++ (loop repeat 6 collect (read-byte s nil 200)))))) ++ (2 3 5 7 11 100) ++ (2 3 5 7 11 200)) ++ ++(deftest make-echo-stream.6 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values (coerce (loop repeat 3 collect (read-char-no-hang s)) 'string) ++ (get-output-stream-string os))) ++ "foo" "foo") ++ ++(deftest make-echo-stream.7 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values (coerce (loop repeat 4 collect (read-char-no-hang s nil '#\z)) ++ 'string) ++ (get-output-stream-string os))) ++ "fooz" "foo") ++ ++;;; peek-char + echo streams is tested in peek-char.lsp ++;;; unread-char + echo streams is tested in unread-char.lsp ++ ++(deftest make-echo-stream.8 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os)) ++ (x (copy-seq "xxxxxx"))) ++ (values ++ (read-sequence x s) ++ x ++ (get-output-stream-string os))) ++ 3 ++ "fooxxx" ++ "foo") ++ ++(deftest make-echo-stream.9 ++ (let ((pn #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (os pn ++ :direction :output ++ :element-type element-type ++ :if-exists :supersede) ++ (loop for x in '(2 3 5 7 11) ++ do (write-byte x os))) ++ (with-open-file ++ (is pn :direction :input :element-type element-type) ++ (values ++ (with-open-file ++ (os pn2 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (let ((s (make-echo-stream is os)) ++ (x (vector 0 0 0 0 0 0 0 0))) ++ (list (read-sequence x s) ++ x))) ++ (with-open-file ++ (s pn2 :direction :input :element-type element-type) ++ (loop repeat 8 collect (read-byte s nil nil)))))) ++ (5 #(2 3 5 7 11 0 0 0)) ++ (2 3 5 7 11 nil nil nil)) ++ ++(deftest make-echo-stream.10 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (notnot (open-stream-p s)) ++ (close s) ++ (open-stream-p s) ++ (notnot (open-stream-p is)) ++ (notnot (open-stream-p os)))) ++ t t nil t t) ++ ++(deftest make-echo-stream.11 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (notnot (listen s)) ++ (read-char s) ++ (notnot (listen s)) ++ (read-char s) ++ (notnot (listen s)) ++ (read-char s) ++ (listen s))) ++ t #\f t #\o t #\o nil) ++ ++(deftest make-echo-stream.12 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (notnot (streamp s)) ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'echo-stream)) ++ (notnot (input-stream-p s)) ++ (notnot (output-stream-p s)) ++ (notnot (stream-element-type s)))) ++ t t t t t t) ++ ++;;; FIXME ++;;; Add tests for clear-input, file-position(?) ++;;; Also, add tests for output operations (since echo-streams are ++;;; bidirectional) ++ ++(deftest make-echo-stream.13 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-char #\0 s) ++ (close s) ++ (get-output-stream-string os))) ++ #\0 t "0") ++ ++(deftest make-echo-stream.14 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (terpri s) ++ (close s) ++ (get-output-stream-string os))) ++ nil t #.(string #\Newline)) ++ ++(deftest make-echo-stream.15 ++ (let ((pn #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (os pn ++ :direction :output ++ :element-type element-type ++ :if-exists :supersede)) ++ (with-open-file ++ (is pn :direction :input :element-type element-type) ++ (values ++ (with-open-file ++ (os pn2 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (let ((s (make-echo-stream is os)) ++ (x (mapcar #'char-code (coerce "abcdefg" 'list)))) ++ (loop for b in x do ++ (assert (equal (list b) ++ (multiple-value-list (write-byte b s))))) ++ (close s))))) ++ (with-open-file ++ (is pn2 :direction :input :element-type element-type) ++ (let ((x (vector 0 0 0 0 0 0 0))) ++ (read-sequence x is) ++ (values ++ (read-byte is nil :done) ++ (map 'string #'code-char x))))) ++ :done ++ "abcdefg") ++ ++(deftest make-echo-stream.16 ++ (let ((pn #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (os pn ++ :direction :output ++ :element-type element-type ++ :if-exists :supersede)) ++ (with-open-file ++ (is pn :direction :input :element-type element-type) ++ (values ++ (with-open-file ++ (os pn2 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (let ((s (make-echo-stream is os)) ++ (x (map 'vector #'char-code "abcdefg"))) ++ (assert (equal (multiple-value-list (write-sequence x s)) (list x))) ++ (close s))))) ++ (with-open-file ++ (is pn2 :direction :input :element-type element-type) ++ (let ((x (vector 0 0 0 0 0 0 0))) ++ (read-sequence x is) ++ (values ++ (read-byte is nil :done) ++ (map 'string #'code-char x))))) ++ :done ++ "abcdefg") ++ ++(deftest make-echo-stream.17 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-char #\X s) ++ (notnot (fresh-line s)) ++ (finish-output s) ++ (force-output s) ++ (close s) ++ (get-output-stream-string os))) ++ #\X t nil nil t #.(coerce '(#\X #\Newline) 'string)) ++ ++(deftest make-echo-stream.18 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-string "159" s) ++ (close s) ++ (get-output-stream-string os))) ++ "159" t "159") ++ ++(deftest make-echo-stream.20 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-string "0159X" s :start 1 :end 4) ++ (close s) ++ (get-output-stream-string os))) ++ "0159X" t "159") ++ ++(deftest make-echo-stream.21 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-line "159" s) ++ (close s) ++ (get-output-stream-string os))) ++ "159" t #.(concatenate 'string "159" (string #\Newline))) ++ ++(deftest make-echo-stream.22 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-echo-stream is os))) ++ (values ++ (write-char #\0 s) ++ (clear-output s))) ++ #\0 nil) ++ ++;;; Error tests ++ ++(deftest make-echo-stream.error.1 ++ (signals-error (make-echo-stream) program-error) ++ t) ++ ++(deftest make-echo-stream.error.2 ++ (signals-error (make-echo-stream *standard-input*) program-error) ++ t) ++ ++(deftest make-echo-stream.error.3 ++ (signals-error (make-echo-stream *standard-input* *standard-output* nil) ++ program-error) ++ t) ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-pathname.lsp +@@ -0,0 +1,171 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Nov 29 05:54:30 2003 ++;;;; Contains: Tests of MAKE-PATHNAME ++ ++(in-package :cl-test) ++ ++(defvar *null-pathname* ++ (make-pathname)) ++ ++(defun make-pathname-test ++ (&rest args &key (defaults nil) ++ (host (if defaults (pathname-host defaults) ++ (pathname-host *default-pathname-defaults*))) ++ (device (if defaults (pathname-device defaults) ++ (pathname-device *null-pathname*))) ++ (directory (if defaults (pathname-directory defaults) ++ (pathname-directory *null-pathname*))) ++ (name (if defaults (pathname-name defaults) ++ (pathname-name *null-pathname*))) ++ (type (if defaults (pathname-type defaults) ++ (pathname-type *null-pathname*))) ++ (version (if defaults (pathname-version defaults) ++ (pathname-version *null-pathname*))) ++ case) ++ (declare (ignorable case)) ++ (let* ((vals (multiple-value-list (apply #'make-pathname args))) ++ (pn (first vals))) ++ (and (= (length vals) 1) ++ (typep pn 'pathname) ++ (equalp (pathname-host pn) host) ++ (equalp (pathname-device pn) device) ++ ;; (equalp (pathname-directory pn) directory) ++ (let ((pnd (pathname-directory pn))) ++ (if (eq directory :wild) ++ (member pnd '((:absolute :wild-inferiors) ++ (:absolute :wild)) ++ :test #'equal) ++ (equalp pnd directory))) ++ (equalp (pathname-name pn) name) ++ (equalp (pathname-type pn) type) ++ (equalp (pathname-version pn) version) ++ t))) ++ ++ ++ ++(deftest make-pathname.1 ++ (make-pathname-test) ++ t) ++ ++(deftest make-pathname.2 ++ (make-pathname-test :name "foo") ++ t) ++ ++(deftest make-pathname.2a ++ (do-special-strings ++ (s "foo") ++ (assert (make-pathname-test :name s))) ++ nil) ++ ++(deftest make-pathname.3 ++ (make-pathname-test :name "foo" :type "txt") ++ t) ++ ++(deftest make-pathname.3a ++ (do-special-strings ++ (s "txt") ++ (assert (make-pathname-test :name "foo" :type s))) ++ nil) ++ ++(deftest make-pathname.4 ++ (make-pathname-test :type "lsp") ++ t) ++ ++(deftest make-pathname.5 ++ (make-pathname-test :directory :wild) ++ t) ++ ++(deftest make-pathname.6 ++ (make-pathname-test :name :wild) ++ t) ++ ++(deftest make-pathname.7 ++ (make-pathname-test :type :wild) ++ t) ++ ++(deftest make-pathname.8 ++ (make-pathname-test :version :wild) ++ t) ++ ++(deftest make-pathname.9 ++ (make-pathname-test :defaults *default-pathname-defaults*) ++ t) ++ ++(deftest make-pathname.10 ++ (make-pathname-test :defaults (make-pathname :name "foo" :type "bar")) ++ t) ++ ++(deftest make-pathname.11 ++ (make-pathname-test :version :newest) ++ t) ++ ++(deftest make-pathname.12 ++ (make-pathname-test :case :local) ++ t) ++ ++(deftest make-pathname.13 ++ (make-pathname-test :case :common) ++ t) ++ ++(deftest make-pathname.14 ++ (let ((*default-pathname-defaults* ++ (make-pathname :name "foo" :type "lsp" :version :newest))) ++ (make-pathname-test)) ++ t) ++ ++;;; Works on the components of actual pathnames ++(deftest make-pathname.rebuild ++ (loop for p in *pathnames* ++ for host = (pathname-host p) ++ for device = (pathname-device p) ++ for directory = (pathname-directory p) ++ for name = (pathname-name p) ++ for type = (pathname-type p) ++ for version = (pathname-version p) ++ for p2 = (make-pathname ++ :host host ++ :device device ++ :directory directory ++ :name name ++ :type type ++ :version version) ++ unless (equal p p2) ++ collect (list p p2)) ++ nil) ++ ++;;; Various constraints on :directory ++ ++(deftest make-pathname-error-absolute-up ++ (signals-error (directory (make-pathname :directory '(:absolute :up))) ++ file-error) ++ t) ++ ++(deftest make-pathname-error-absolute-back ++ (signals-error (directory (make-pathname :directory '(:absolute :back))) ++ file-error) ++ t) ++ ++;; The next test is correct, but was causing very large amounts of time to be spent ++;; in buggy implementations ++;;#| ++(deftest make-pathname-error-absolute-wild-inferiors-up ++ (signals-error (directory (make-pathname :directory '(:absolute :wild-inferiors :up))) ++ file-error) ++ t) ++;;|# ++ ++(deftest make-pathname-error-relative-wild-inferiors-up ++ (signals-error (length (directory (make-pathname :directory '(:relative :wild-inferiors :up)))) ++ file-error) ++ t) ++ ++(deftest make-pathname-error-absolute-wild-inferiors-back ++ (signals-error (directory (make-pathname :directory '(:absolute :wild-inferiors :back))) ++ file-error) ++ t) ++ ++(deftest make-pathname-error-relative-wild-inferiors-back ++ (signals-error (directory (make-pathname :directory '(:relative :wild-inferiors :back))) ++ file-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-string-input-stream.lsp +@@ -0,0 +1,93 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 18:36:48 2004 ++;;;; Contains: Tests for MAKE-STRING-INPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-string-input-stream.1 ++ (let ((s (make-string-input-stream ""))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (streamp s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s))) ++ t t t nil) ++ ++(deftest make-string-input-stream.2 ++ (let ((s (make-string-input-stream "abcd"))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (streamp s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s))) ++ t t t nil) ++ ++ ++(deftest make-string-input-stream.3 ++ (let ((s (make-string-input-stream "abcd" 1))) ++ (values (read-line s))) ++ "bcd") ++ ++ ++(deftest make-string-input-stream.4 ++ (let ((s (make-string-input-stream "abcd" 0 2))) ++ (values (read-line s))) ++ "ab") ++ ++(deftest make-string-input-stream.5 ++ (let ((s (make-string-input-stream "abcd" 1 nil))) ++ (values (read-line s))) ++ "bcd") ++ ++(deftest make-string-input-stream.6 ++ (let ((str1 (make-array 6 :element-type 'character ++ :initial-contents "abcdef" ++ :fill-pointer 4))) ++ (let ((s (make-string-input-stream str1))) ++ (values (read-line s) (read-char s nil :eof)))) ++ "abcd" :eof) ++ ++(deftest make-string-input-stream.7 ++ (let* ((str1 (make-array 6 :element-type 'character ++ :initial-contents "abcdef")) ++ (str2 (make-array 4 :element-type 'character ++ :displaced-to str1))) ++ (let ((s (make-string-input-stream str2))) ++ (values (read-line s) (read-char s nil :eof)))) ++ "abcd" :eof) ++ ++(deftest make-string-input-stream.8 ++ (let* ((str1 (make-array 6 :element-type 'character ++ :initial-contents "abcdef")) ++ (str2 (make-array 4 :element-type 'character ++ :displaced-to str1 ++ :displaced-index-offset 1))) ++ (let ((s (make-string-input-stream str2))) ++ (values (read-line s) (read-char s nil :eof)))) ++ "bcde" :eof) ++ ++(deftest make-string-input-stream.9 ++ (let ((str1 (make-array 6 :element-type 'character ++ :initial-contents "abcdef" ++ :adjustable t))) ++ (let ((s (make-string-input-stream str1))) ++ (values (read-line s) (read-char s nil :eof)))) ++ "abcdef" :eof) ++ ++(deftest make-string-input-stream.10 ++ :notes (:allow-nil-arrays :nil-vectors-are-strings) ++ (let ((s (make-string-input-stream ++ (make-array 0 :element-type nil)))) ++ (read-char s nil :eof)) ++ :eof) ++ ++;;; Error tests ++ ++(deftest make-string-input-stream.error.1 ++ (signals-error (make-string-input-stream) program-error) ++ t) ++ ++(deftest make-string-input-stream.error.2 ++ (signals-error (make-string-input-stream "abc" 1 2 nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-string-output-stream.lsp +@@ -0,0 +1,139 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 19:42:07 2004 ++;;;; Contains: Tests of MAKE-STRING-OUTPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-string-output-stream.1 ++ (let ((s (make-string-output-stream))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.2 ++ (let ((s (make-string-output-stream :element-type 'character))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.3 ++ (let ((s (make-string-output-stream :element-type 'base-char))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.4 ++ :notes (:nil-vectors-are-strings) ++ (let ((s (make-string-output-stream :element-type nil))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.5 ++ (let ((s (make-string-output-stream :allow-other-keys nil))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.6 ++ (let ((s (make-string-output-stream :allow-other-keys t :foo 'bar))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.7 ++ (let ((s (make-string-output-stream :foo 'bar :allow-other-keys t ++ :allow-other-keys nil ++ :foo2 'x))) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (input-stream-p s) ++ (notnot (output-stream-p s)) ++ (notnot (open-stream-p s)))) ++ t t nil t t) ++ ++(deftest make-string-output-stream.8 ++ (let ((s (make-string-output-stream))) ++ (write-string "abc" s) ++ (write-string "def" s) ++ (get-output-stream-string s)) ++ "abcdef") ++ ++(deftest make-string-output-stream.9 ++ (let ((s (make-string-output-stream :element-type 'character))) ++ (write-string "abc" s) ++ (write-string "def" s) ++ (get-output-stream-string s)) ++ "abcdef") ++ ++(deftest make-string-output-stream.10 ++ (let ((s (make-string-output-stream :element-type 'base-char))) ++ (write-string "abc" s) ++ (write-string "def" s) ++ (get-output-stream-string s)) ++ "abcdef") ++ ++(deftest make-string-output-stream.11 ++ :notes (:nil-vectors-are-strings) ++ (let ((s (make-string-output-stream :element-type nil))) ++ (get-output-stream-string s)) ++ "") ++ ++(deftest make-string-output-stream.12 ++ :notes (:nil-vectors-are-strings) ++ (let ((s (make-string-output-stream :element-type nil))) ++ (typep #\a (array-element-type (get-output-stream-string s)))) ++ nil) ++ ++(deftest make-string-output-stream.13 ++ (let ((s (make-string-output-stream))) ++ (values ++ (close s) ++ (open-stream-p s))) ++ t nil) ++ ++;;; Error tests ++ ++(deftest make-string-output-stream.error.1 ++ (signals-error (make-string-output-stream nil) program-error) ++ t) ++ ++(deftest make-string-output-stream.error.2 ++ (signals-error (make-string-output-stream :foo nil) program-error) ++ t) ++ ++(deftest make-string-output-stream.error.3 ++ (signals-error (make-string-output-stream :allow-other-keys nil ++ :foo 'bar) ++ program-error) ++ t) ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-synonym-stream.lsp +@@ -0,0 +1,97 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 28 06:54:33 2004 ++;;;; Contains: Tests of MAKE-SYNONYM-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-synonym-stream.1 ++ (with-input-from-string ++ (*s* "abcde") ++ (declare (special *s*)) ++ (let ((ss (make-synonym-stream '*s*))) ++ (assert (typep ss 'stream)) ++ (assert (typep ss 'synonym-stream)) ++ (assert (input-stream-p ss)) ++ (assert (not (output-stream-p ss))) ++ (assert (open-stream-p ss)) ++ (assert (streamp ss)) ++ (assert (stream-element-type ss)) ++ (values ++ (read-char *s*) ++ (read-char ss) ++ (read-char *s*) ++ (read-char ss) ++ (read-char ss)))) ++ #\a #\b #\c #\d #\e) ++ ++ ++;;; This test was wrong (section 21.1.4) ++#| ++(deftest make-synonym-stream.2 ++ (let ((ss (make-synonym-stream '*s*))) ++ (with-input-from-string ++ (*s* "z") ++ (declare (special *s*)) ++ (assert (typep ss 'stream)) ++ (assert (typep ss 'synonym-stream)) ++ (assert (input-stream-p ss)) ++ (assert (not (output-stream-p ss))) ++ (assert (open-stream-p ss)) ++ (assert (streamp ss)) ++ (assert (stream-element-type ss)) ++ (read-char ss))) ++ #\z) ++|# ++ ++(deftest make-synonym-stream.3 ++ (with-output-to-string ++ (*s*) ++ (declare (special *s*)) ++ (let ((ss (make-synonym-stream '*s*))) ++ (assert (typep ss 'stream)) ++ (assert (typep ss 'synonym-stream)) ++ (assert (output-stream-p ss)) ++ (assert (not (input-stream-p ss))) ++ (assert (open-stream-p ss)) ++ (assert (streamp ss)) ++ (assert (stream-element-type ss)) ++ (write-char #\a *s*) ++ (write-char #\b ss) ++ (write-char #\x *s*) ++ (write-char #\y ss))) ++ "abxy") ++ ++(deftest make-synonym-stream.4 ++ (let ((ss (make-synonym-stream '*terminal-io*))) ++ (assert (typep ss 'stream)) ++ (assert (typep ss 'synonym-stream)) ++ (assert (output-stream-p ss)) ++ (assert (input-stream-p ss)) ++ (assert (open-stream-p ss)) ++ (assert (streamp ss)) ++ (assert (stream-element-type ss)) ++ nil) ++ nil) ++ ++ ++;;; FIXME ++;;; Add tests for: close, ++;;; peek-char, read-char-no-hang, terpri, fresh-line, unread-char, ++;;; read-line, write-line, write-string, read-sequence, write-sequence, ++;;; read-byte, write-byte, listen, clear-input, finish-output, force-output, ++;;; clear-output, format, print, prin1, princ ++ ++;;; Error cases ++ ++(deftest make-synonym-stream.error.1 ++ (signals-error (make-synonym-stream) program-error) ++ t) ++ ++(deftest make-synonym-stream.error.2 ++ (signals-error (make-synonym-stream '*standard-input* nil) program-error) ++ t) ++ ++(deftest make-synonym-stream.error.3 ++ (check-type-error #'make-synonym-stream #'symbolp) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/make-two-way-stream.lsp +@@ -0,0 +1,244 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Fri Jan 30 05:39:56 2004 ++;;;; Contains: Tests for MAKE-TWO-WAY-STREAM ++ ++(in-package :cl-test) ++ ++(deftest make-two-way-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (assert (typep s 'stream)) ++ (assert (typep s 'two-way-stream)) ++ (assert (streamp s)) ++ (assert (open-stream-p s)) ++ (assert (input-stream-p s)) ++ (assert (output-stream-p s)) ++ (assert (stream-element-type s)) ++ (values ++ (read-char s) ++ (write-char #\b s) ++ (read-char s) ++ (write-char #\a s) ++ (read-char s) ++ (write-char #\r s) ++ (get-output-stream-string os))) ++ #\f #\b #\o #\a #\o #\r "bar") ++ ++(deftest make-two-way-stream.2 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (close s) ++ (open-stream-p s) ++ (notnot (open-stream-p is)) ++ (notnot (open-stream-p os)) ++ (write-char #\8 os) ++ (get-output-stream-string os))) ++ t nil t t #\8 "8") ++ ++(deftest make-two-way-stream.3 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (peek-char nil s) ++ (read-char s) ++ (get-output-stream-string os))) ++ #\f #\f "") ++ ++(deftest make-two-way-stream.4 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (read-char-no-hang s) ++ (read-char-no-hang s nil) ++ (read-char-no-hang s t :eof) ++ (read-char-no-hang s nil :eof) ++ (get-output-stream-string os))) ++ #\f #\o #\o :eof "") ++ ++(deftest make-two-way-stream.5 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (terpri s) ++ (get-output-stream-string os))) ++ nil #.(string #\Newline)) ++ ++(deftest make-two-way-stream.6 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (write-char #\+ s) ++ (notnot (fresh-line s)) ++ (read-char s) ++ (get-output-stream-string os))) ++ #\+ t #\f #.(coerce (list #\+ #\Newline) 'string)) ++ ++(deftest make-two-way-stream.7 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (read-char s) ++ (unread-char #\f s) ++ (read-char s) ++ (read-char s) ++ (unread-char #\o s) ++ (get-output-stream-string os))) ++ #\f nil #\f #\o nil "") ++ ++(deftest make-two-way-stream.8 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (read-line s) ++ (get-output-stream-string os))) ++ "foo" "") ++ ++(deftest make-two-way-stream.9 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (write-string "bar" s) ++ (get-output-stream-string os))) ++ "bar" "bar") ++ ++(deftest make-two-way-stream.10 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (write-line "bar" s) ++ (get-output-stream-string os))) ++ "bar" #.(concatenate 'string "bar" '(#\Newline))) ++ ++(deftest make-two-way-stream.11 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (let ((x (vector nil nil nil))) ++ (values ++ (read-sequence x s) ++ x ++ (get-output-stream-string os)))) ++ 3 #(#\f #\o #\o) "") ++ ++(deftest make-two-way-stream.12 ++ (let ((pn1 #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 8))) ++ (with-open-file (s pn1 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (dolist (b '(3 8 19 41)) (write-byte b s))) ++ (with-open-file ++ (is pn1 :direction :input :element-type element-type) ++ (with-open-file ++ (os pn2 :direction :output :element-type element-type ++ :if-exists :supersede) ++ (let ((s (make-two-way-stream is os)) ++ (x (vector nil nil nil nil))) ++ (assert (eql (read-sequence x s) 4)) ++ (assert (equalp x #(3 8 19 41))) ++ (let ((y #(100 5 18 211 0 178))) ++ (assert (eql (write-sequence y s) y)) ++ (close s))))) ++ (with-open-file ++ (s pn2 :direction :input :element-type element-type) ++ (let ((x (vector nil nil nil nil nil nil nil))) ++ (values ++ (read-sequence x s) ++ x)))) ++ 6 ++ #(100 5 18 211 0 178 nil)) ++ ++(deftest make-two-way-stream.13 ++ (let ((pn1 #p"tmp.dat") ++ (pn2 #p"tmp2.dat") ++ (element-type '(unsigned-byte 32))) ++ (with-open-file (s pn1 :direction :output :if-exists :supersede ++ :element-type element-type) ++ (dolist (b '(3 8 19 41)) (write-byte b s))) ++ (with-open-file ++ (is pn1 :direction :input :element-type element-type) ++ (with-open-file ++ (os pn2 :direction :output :element-type element-type ++ :if-exists :supersede) ++ (let ((s (make-two-way-stream is os)) ++ (x (vector nil nil nil nil))) ++ (assert (eql (read-sequence x s) 4)) ++ (assert (equalp x #(3 8 19 41))) ++ (let ((y #(100 5 18 211 0 178))) ++ (assert (eql (write-sequence y s) y)) ++ (close s))))) ++ (with-open-file ++ (s pn2 :direction :input :element-type element-type) ++ (let ((x (vector nil nil nil nil nil nil nil))) ++ (values ++ (read-sequence x s) ++ x)))) ++ 6 ++ #(100 5 18 211 0 178 nil)) ++ ++(deftest make-two-way-stream.14 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (values ++ (write-string "abc" s) ++ (clear-input s) ++ (write-string "def" s) ++ (get-output-stream-string os))) ++ "abc" nil "def" "abcdef") ++ ++;;; Error tests ++ ++(deftest make-two-way-stream.error.1 ++ (signals-error (make-two-way-stream) program-error) ++ t) ++ ++(deftest make-two-way-stream.error.2 ++ (signals-error (make-two-way-stream (make-string-input-stream "foo")) ++ program-error) ++ t) ++ ++(deftest make-two-way-stream.error.3 ++ (signals-error (let ((os (make-string-output-stream))) ++ (make-two-way-stream (make-string-input-stream "foo") ++ os nil)) ++ program-error) ++ t) ++ ++(deftest make-two-way-stream.error.4 ++ (check-type-error #'(lambda (x) (make-two-way-stream x (make-string-output-stream))) ++ #'(lambda (x) (and (streamp x) (input-stream-p x)))) ++ nil) ++ ++(deftest make-two-way-stream.error.5 ++ (check-type-error #'(lambda (x) (make-two-way-stream x (make-string-output-stream))) ++ #'(lambda (x) (and (streamp x) (input-stream-p x))) ++ *streams*) ++ nil) ++ ++(deftest make-two-way-stream.error.6 ++ (check-type-error #'(lambda (x) (make-two-way-stream (make-string-input-stream "foo") x)) ++ #'(lambda (x) (and (streamp x) (output-stream-p x)))) ++ nil) ++ ++(deftest make-two-way-stream.error.7 ++ (check-type-error #'(lambda (x) (make-two-way-stream (make-string-input-stream "foo") x)) ++ #'(lambda (x) (and (streamp x) (output-stream-p x))) ++ *streams*) ++ nil) ++ ++ ++ ++ +\ No newline at end of file +--- /dev/null ++++ gcl-2.6.12/ansi-tests/merge-pathnames.lsp +@@ -0,0 +1,124 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Dec 31 11:25:55 2003 ++;;;; Contains: Tests of MERGE-PATHNAMES ++ ++(in-package :cl-test) ++ ++#| ++(defun merge-pathnames-test (&rest args) ++ (assert (<= 1 (length args) 3)) ++ (let* ((p1 (car args)) ++ (p2 (if (cdr args) (cadr args) *default-pathname-defaults*)) ++ (default-version (if (cddr args) (caddr args) :newest)) ++ (results (multiple-value-list (apply #'merge-pathnames args)))) ++ (assert (= (length results) 1)) ++ (let ((p3 (first results))) ++ ++|# ++ ++(deftest merge-pathnames.1 ++ (let* ((p1 (make-pathname :name "foo")) ++ (p2 (merge-pathnames p1 p1 nil))) ++ (values ++ (equalpt (pathname-name p1) "foo") ++ (if (equalpt p1 p2) t ++ (list p1 p2)))) ++ t t) ++ ++(deftest merge-pathnames.2 ++ (let* ((p1 (make-pathname :name "foo")) ++ (p2 (merge-pathnames p1 p1))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p2)) ++ (equalpt (pathname-device p1) (pathname-device p2)) ++ (equalpt (pathname-directory p1) (pathname-directory p2)) ++ (pathname-name p1) ++ (pathname-name p2) ++ (equalpt (pathname-type p1) (pathname-type p2)) ++ (if (pathname-version p1) ++ (equalpt (pathname-version p1) (pathname-version p2)) ++ (equalpt (pathname-version p2) :newest)))) ++ t t t "foo" "foo" t t) ++ ++(deftest merge-pathnames.3 ++ (let* ((p1 (make-pathname :name "foo")) ++ (p2 (make-pathname :name "bar")) ++ (p3 (merge-pathnames p1 p2))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p3)) ++ (equalpt (pathname-device p1) (pathname-device p3)) ++ (equalpt (pathname-directory p1) (pathname-directory p3)) ++ (pathname-name p1) ++ (pathname-name p3) ++ (equalpt (pathname-type p1) (pathname-type p3)) ++ (if (pathname-version p1) ++ (equalpt (pathname-version p1) (pathname-version p3)) ++ (equalpt (pathname-version p3) :newest)))) ++ t t t "foo" "foo" t t) ++ ++(deftest merge-pathnames.4 ++ (let* ((p1 (make-pathname :name "foo")) ++ (p2 (make-pathname :type "lsp")) ++ (p3 (merge-pathnames p1 p2))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p3)) ++ (equalpt (pathname-device p1) (pathname-device p3)) ++ (equalpt (pathname-directory p1) (pathname-directory p3)) ++ (pathname-name p1) ++ (pathname-type p2) ++ (pathname-type p3) ++ (equalpt (pathname-type p2) (pathname-type p3)) ++ (if (pathname-version p1) ++ (equalpt (pathname-version p1) (pathname-version p3)) ++ (equalpt (pathname-version p3) :newest)))) ++ t t t "foo" "lsp" "lsp" t t) ++ ++(deftest merge-pathnames.5 ++ (let* ((p1 (make-pathname :name "foo")) ++ (p2 (make-pathname :type "lsp" :version :newest)) ++ (p3 (merge-pathnames p1 p2 nil))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p3)) ++ (equalpt (pathname-device p1) (pathname-device p3)) ++ (equalpt (pathname-directory p1) (pathname-directory p3)) ++ (pathname-name p1) ++ (pathname-name p3) ++ (pathname-type p2) ++ (pathname-type p3) ++ (equalpt (pathname-version p1) (pathname-version p3)))) ++ t t t "foo" "foo" "lsp" "lsp" t) ++ ++(deftest merge-pathnames.6 ++ (let* ((p1 (make-pathname)) ++ (p2 (make-pathname :name "foo" :version :newest)) ++ (p3 (merge-pathnames p1 p2 nil))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p3)) ++ (equalpt (pathname-device p1) (pathname-device p3)) ++ (equalpt (pathname-directory p1) (pathname-directory p3)) ++ (pathname-name p2) ++ (pathname-name p3) ++ (equalpt (pathname-type p2) (pathname-type p3)) ++ (pathname-version p2) ++ (pathname-version p3))) ++ t t t "foo" "foo" t :newest :newest) ++ ++(deftest merge-pathnames.7 ++ (let* ((p1 (make-pathname)) ++ (p2 *default-pathname-defaults*) ++ (p3 (merge-pathnames p1))) ++ (values ++ (equalpt (pathname-host p1) (pathname-host p3)) ++ (equalpt (pathname-host p2) (pathname-host p3)) ++ (equalpt (pathname-device p2) (pathname-device p3)) ++ (equalpt (pathname-directory p2) (pathname-directory p3)) ++ (equalpt (pathname-name p2) (pathname-name p3)) ++ (equalpt (pathname-type p2) (pathname-type p3)) ++ (cond ++ ((pathname-version p1) (equalpt (pathname-version p1) ++ (pathname-version p3))) ++ ((pathname-version p2) (equalpt (pathname-version p2) ++ (pathname-version p3))) ++ (t (equalpt (pathname-version p3) :newest))))) ++ t t t t t t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/namestring.lsp +@@ -0,0 +1,64 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Sep 2 07:24:42 2004 ++;;;; Contains: Tests for NAMESTRING ++ ++(in-package :cl-test) ++ ++(deftest namestring.1 ++ (let* ((vals (multiple-value-list (namestring "namestring.lsp"))) ++ (s (first vals))) ++ (if (and (null (cdr vals)) ++ (stringp s) ++ (equal (namestring s) s)) ++ :good ++ vals)) ++ :good) ++ ++(deftest namestring.2 ++ (do-special-strings ++ (s "namestring.lsp" nil) ++ (let ((ns (namestring s))) ++ (assert (stringp ns)) ++ (assert (string= (namestring ns) ns)))) ++ nil) ++ ++;;; I'm not convinced these tested required behavior, so I'm commenting ++;;; them out for now. FIXME: determine if they are bogus ++#| ++(deftest namestring.3 ++ (let* ((name "namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (namestring pn)) ++ (pn2 (pathname name2))) ++ (or (equalt pn pn2) (list (list pn (pathname-host pn) (pathname-device pn) ++ (pathname-directory pn) (pathname-name pn) ++ (pathname-type pn) (pathname-version pn)) ++ (list pn2 (pathname-host pn2) (pathname-device pn2) ++ (pathname-directory pn2) (pathname-name pn2) ++ (pathname-type pn2) (pathname-version pn2))))) ++ t) ++ ++(deftest namestring.4 ++ (let* ((name "namestring.lsp") ++ (pn (merge-pathnames (pathname name))) ++ (name2 (with-open-file (s pn :direction :input) (namestring s))) ++ (pn2 (pathname name2))) ++ (or (equalt pn pn2) (list (list pn (pathname-host pn) (pathname-device pn) ++ (pathname-directory pn) (pathname-name pn) ++ (pathname-type pn) (pathname-version pn)) ++ (list pn2 (pathname-host pn2) (pathname-device pn2) ++ (pathname-directory pn2) (pathname-name pn2) ++ (pathname-type pn2) (pathname-version pn2))))) ++ t) ++|# ++ ++;;; Error tests ++ ++(deftest namestring.error.1 ++ (signals-error (namestring) program-error) ++ t) ++ ++(deftest namestring.error.2 ++ (signals-error (namestring "namestring.lsp" nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/open-stream-p.lsp +@@ -0,0 +1,54 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:52:30 2004 ++;;;; Contains: Tests of OPEN-STREAM-P ++ ++(in-package :cl-test) ++ ++(deftest open-stream-p.1 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-input* *standard-output* ++ *trace-output* *terminal-io*) ++ for results = (multiple-value-list (open-stream-p s)) ++ unless (and (eql (length results) 1) ++ (car results)) ++ collect s) ++ nil) ++ ++(deftest open-stream-p.2 ++ (with-open-file (s "open-stream-p.lsp" :direction :input) ++ (notnot-mv (open-stream-p s))) ++ t) ++ ++(deftest open-stream-p.3 ++ (with-open-file (s "foo.txt" :direction :output ++ :if-exists :supersede) ++ (notnot-mv (open-stream-p s))) ++ t) ++ ++(deftest open-stream-p.4 ++ (let ((s (open "open-stream-p.lsp" :direction :input))) ++ (close s) ++ (open-stream-p s)) ++ nil) ++ ++(deftest open-stream-p.5 ++ (let ((s (open "foo.txt" :direction :output ++ :if-exists :supersede))) ++ (close s) ++ (open-stream-p s)) ++ nil) ++ ++;;; error tests ++ ++(deftest open-stream-p.error.1 ++ (signals-error (open-stream-p) program-error) ++ t) ++ ++(deftest open-stream-p.error.2 ++ (signals-error (open-stream-p *standard-input* nil) program-error) ++ t) ++ ++(deftest open-stream-p.error.3 ++ (check-type-error #'open-stream-p #'streamp) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/open.lsp +@@ -0,0 +1,1238 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Fri Jan 23 05:36:55 2004 ++;;;; Contains: Tests of OPEN ++ ++(in-package :cl-test) ++ ++;;; Input streams ++ ++(defun generator-for-element-type (type) ++ (etypecase type ++ ((member character base-char) ++ #'(lambda (i) (aref "abcdefghijklmnopqrstuvwxyz" (mod i 26)))) ++ ((member signed-byte unsigned-byte bit) ++ #'(lambda (i) (logand i 1))) ++ (cons ++ (let ((op (car type)) ++ (arg1 (cadr type)) ++ (arg2 (caddr type))) ++ (ecase op ++ (unsigned-byte ++ (let ((mask (1- (ash 1 arg1)))) ++ #'(lambda (i) (logand i mask)))) ++ (signed-byte ++ (let ((mask (1- (ash 1 (1- arg1))))) ++ #'(lambda (i) (logand i mask)))) ++ (integer ++ (let* ((lo arg1) ++ (hi arg2) ++ (lower-bound ++ (etypecase lo ++ (integer lo) ++ (cons (1+ (car lo))))) ++ (upper-bound ++ (etypecase hi ++ (integer hi) ++ (cons (1- (car hi))))) ++ (range (1+ (- upper-bound lower-bound)))) ++ #'(lambda (i) (+ lower-bound (mod i range)))))))))) ++ ++(compile 'generator-for-element-type) ++ ++(defmacro def-open-test (name args form expected ++ &key ++ (notes nil notes-p) ++ (build-form nil build-form-p) ++ (element-type 'character element-type-p) ++ (pathname #p"tmp.dat")) ++ ++ (when element-type-p ++ (setf args (append args (list :element-type `',element-type)))) ++ ++ (unless build-form-p ++ (let ((write-element-form ++ (cond ++ ((subtypep element-type 'integer) ++ `(write-byte ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ os)) ++ ((subtypep element-type 'character) ++ `(write-char ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ os))))) ++ (setq build-form ++ `(with-open-file ++ (os pn :direction :output ++ ,@(if element-type-p ++ `(:element-type ',element-type)) ++ :if-exists :supersede) ++ (assert (open-stream-p os)) ++ (dotimes (i 10) ,write-element-form) ++ (finish-output os) ++ )))) ++ ++ `(deftest ,name ++ ,@(when notes-p `(:notes ,notes)) ++ (let ((pn ,pathname)) ++ (delete-all-versions pn) ++ ,build-form ++ (let ((s (open pn ,@args))) ++ (unwind-protect ++ (progn ++ (assert (open-stream-p s)) ++ (assert (typep s 'file-stream)) ++ ,@ ++ (unless (member element-type '(signed-byte unsigned-byte)) ++ #-allegro ++ `((assert (subtypep ',element-type ++ (stream-element-type s)))) ++ #+allegro nil ++ ) ++ ,form) ++ (close s)))) ++ ,@expected)) ++ ++;; (compile 'def-open-test) ++ ++(def-open-test open.1 () (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.2 (:direction :input) ++ (values (read-line s nil)) ("abcdefghij") :element-type character) ++(def-open-test open.3 (:direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.4 (:direction :input) ++ (values (read-line s nil)) ("abcdefghij") :element-type base-char) ++(def-open-test open.5 (:if-exists :error) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.6 (:if-exists :error :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.7 (:if-exists :new-version) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.8 (:if-exists :new-version :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.9 (:if-exists :rename) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.10 (:if-exists :rename :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.11 (:if-exists :rename-and-delete) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.12 (:if-exists :rename-and-delete :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.13 (:if-exists :overwrite) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.14 (:if-exists :overwrite :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.15 (:if-exists :append) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.16 (:if-exists :append :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.17 (:if-exists :supersede) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.18 (:if-exists :supersede :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.19 (:if-exists nil) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.20 (:if-exists nil :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++ ++(def-open-test open.21 (:if-does-not-exist nil) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.22 (:if-does-not-exist nil :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.23 (:if-does-not-exist :error) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.24 (:if-does-not-exist :error :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.25 (:if-does-not-exist :create) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.26 (:if-does-not-exist :create :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++ ++(def-open-test open.27 (:external-format :default) ++ (values (read-line s nil)) ("abcdefghij")) ++(def-open-test open.28 (:external-format :default :direction :input) ++ (values (read-line s nil)) ("abcdefghij")) ++ ++(def-open-test open.29 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type (unsigned-byte 1)) ++(def-open-test open.30 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type (unsigned-byte 1)) ++ ++(def-open-test open.31 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 0 1 2 3 0 1)) :element-type (unsigned-byte 2)) ++(def-open-test open.32 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 0 1 2 3 0 1)) :element-type (unsigned-byte 2)) ++ ++(def-open-test open.33 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 0 1)) :element-type (unsigned-byte 3)) ++(def-open-test open.34 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 0 1)) :element-type (unsigned-byte 3)) ++ ++(def-open-test open.35 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 4)) ++(def-open-test open.36 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 4)) ++ ++(def-open-test open.37 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 5)) ++(def-open-test open.38 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 5)) ++ ++(def-open-test open.39 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 6)) ++(def-open-test open.40 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 6)) ++ ++(def-open-test open.41 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 7)) ++(def-open-test open.42 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 7)) ++ ++(def-open-test open.43 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 8)) ++(def-open-test open.44 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 8)) ++ ++(def-open-test open.45 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 9)) ++(def-open-test open.46 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 9)) ++ ++(def-open-test open.47 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 10)) ++(def-open-test open.48 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 10)) ++ ++(def-open-test open.49 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 20)) ++(def-open-test open.50 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 20)) ++ ++(def-open-test open.51 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 25)) ++(def-open-test open.52 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 25)) ++ ++(def-open-test open.53 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 30)) ++(def-open-test open.54 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 30)) ++ ++(def-open-test open.55 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 32)) ++(def-open-test open.56 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 32)) ++ ++(def-open-test open.57 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 33)) ++(def-open-test open.58 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 2 3 4 5 6 7 8 9)) :element-type (unsigned-byte 33)) ++ ++(def-open-test open.59 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type unsigned-byte) ++(def-open-test open.60 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type unsigned-byte) ++ ++(def-open-test open.61 () ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type signed-byte) ++(def-open-test open.62 (:direction :input) ++ (let ((seq (make-array 10))) (read-sequence seq s) seq) ++ (#(0 1 0 1 0 1 0 1 0 1)) :element-type signed-byte) ++ ++ ++(def-open-test open.63 () ++ (values (read-line s nil)) ("abcdefghij") ++ :pathname "tmp.dat") ++ ++(def-open-test open.64 () ++ (values (read-line s nil)) ("abcdefghij") ++ :pathname (logical-pathname "CLTEST:TMP.DAT")) ++ ++;;; It works on recognizable subtypes. ++(deftest open.65 ++ (let ((type '(or (integer 0 1) (integer 100 200))) ++ (pn #p"tmp.dat") ++ (vals '(0 1 100 120 130 190 200 1 0 150))) ++ (or ++ (not (subtypep type 'integer)) ++ (progn ++ (with-open-file ++ (os pn :direction :output ++ :element-type type ++ :if-exists :supersede) ++ (dolist (e vals) (write-byte e os))) ++ (let ((s (open pn :direction :input ++ :element-type type)) ++ (seq (make-array 10))) ++ (unwind-protect ++ (progn (read-sequence seq s) seq) ++ (close s)) ++ (notnot (every #'eql seq vals)))))) ++ t) ++ ++;;; FIXME: Add -- tests for when the filespec is a stream ++ ++(deftest open.66 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :io :if-exists :rename-and-delete ++ :if-does-not-exist :create) ++ (format s "some stuff~%") ++ (finish-output s) ++ (let ((is (open s :direction :input))) ++ (unwind-protect ++ (values ++ (read-char is) ++ (notnot (file-position s :start)) ++ (read-line is) ++ (read-line s)) ++ (close is))))) ++ #\s ++ t ++ "ome stuff" ++ "some stuff") ++ ++(deftest open.67 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (let ((s (open pn :direction :output))) ++ (unwind-protect ++ (progn ++ (format s "some stuff~%") ++ (finish-output s) ++ (close s) ++ (let ((is (open s :direction :input))) ++ (unwind-protect ++ (values (read-line is)) ++ (close is)))) ++ (when (open-stream-p s) (close s))))) ++ "some stuff") ++ ++;;; FIXME: Add -- tests for when element-type is :default ++ ++;;; Tests of file creation ++ ++(defmacro def-open-output-test ++ (name args form expected ++ &rest keyargs ++ &key ++ (element-type 'character) ++ (build-form ++ `(dotimes (i 10) ++ ,(cond ++ ((subtypep element-type 'integer) ++ `(write-byte ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ s)) ++ ((subtypep element-type 'character) ++ `(write-char ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ s))))) ++ &allow-other-keys) ++ `(def-open-test ,name (:direction :output ,@args) ++ (progn ++ ,build-form ++ (assert (output-stream-p s)) ++ ,form) ++ ,expected ++ :build-form nil ++ ,@keyargs)) ++ ++;; (compile 'def-open-output-test) ++ ++(def-open-output-test open.output.1 () ++ (progn (close s) ++ (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.2 () ++ (progn (close s) ++ (with-open-file (is "tmp.dat") (values (read-line is nil)))) ++ ("abcdefghij") ++ :pathname "tmp.dat") ++ ++(def-open-output-test open.output.3 ++ () ++ (progn (close s) ++ (with-open-file (is (logical-pathname "CLTEST:TMP.DAT")) ++ (values (read-line is nil)))) ++ ("abcdefghij") ++ :pathname (logical-pathname "CLTEST:TMP.DAT")) ++ ++(def-open-output-test open.output.4 () ++ (progn (close s) ++ (with-open-file (is #p"tmp.dat" :element-type 'character) ++ (values (read-line is nil)))) ++ ("abcdefghij") ++ :element-type character) ++ ++(def-open-output-test open.output.5 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type 'base-char) ++ (values (read-line is nil)))) ++ ("abcdefghij") ++ :element-type base-char) ++ ++(def-open-output-test open.output.6 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(integer 0 1)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type (integer 0 1)) ++ ++(def-open-output-test open.output.7 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type 'bit) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type bit) ++ ++(def-open-output-test open.output.8 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 1)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type (unsigned-byte 1)) ++ ++(def-open-output-test open.output.9 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 2)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 0 1 2 3 0 1)) ++ :element-type (unsigned-byte 2)) ++ ++(def-open-output-test open.output.10 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 3)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 0 1)) ++ :element-type (unsigned-byte 3)) ++ ++(def-open-output-test open.output.11 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 4)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 4)) ++ ++ ++(def-open-output-test open.output.12 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 6)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 6)) ++ ++(def-open-output-test open.output.13 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 8)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 8)) ++ ++(def-open-output-test open.output.14 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 12)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 12)) ++ ++(def-open-output-test open.output.15 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 16)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 16)) ++ ++(def-open-output-test open.output.16 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 24)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 24)) ++ ++(def-open-output-test open.output.17 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 32)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 32)) ++ ++(def-open-output-test open.output.18 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 64)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 64)) ++ ++(def-open-output-test open.output.19 () ++ (progn (close s) (with-open-file (is #p"tmp.dat" ++ :element-type '(unsigned-byte 100)) ++ (let ((seq (make-array 10))) ++ (read-sequence seq is) ++ seq))) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 100)) ++ ++(deftest open.output.20 ++ (let ((pn #p"tmp.dat")) ++ (with-open-file (s pn :direction :output :if-exists :supersede)) ++ (open pn :direction :output :if-exists nil)) ++ nil) ++ ++(def-open-test open.output.21 (:if-exists :new-version :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("wxyz") ++ :notes (:open-if-exists-new-version-no-error) ++ ) ++ ++(def-open-test open.output.22 (:if-exists :rename :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("wxyz")) ++ ++(def-open-test open.output.23 (:if-exists :rename-and-delete ++ :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("wxyz")) ++ ++(def-open-test open.output.24 (:if-exists :overwrite ++ :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("wxyzefghij")) ++ ++(def-open-test open.output.25 (:if-exists :append ++ :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("abcdefghijwxyz")) ++ ++(def-open-test open.output.26 (:if-exists :supersede ++ :direction :output) ++ (progn (write-sequence "wxyz" s) ++ (close s) ++ (with-open-file ++ (s pn :direction :input) ++ (values (read-line s nil)))) ++ ("wxyz")) ++ ++(def-open-output-test open.output.27 (:if-does-not-exist :create ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(deftest open.output.28 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :output :if-does-not-exist nil)) ++ nil) ++ ++(def-open-output-test open.output.28a (:external-format :default) ++ (progn (close s) ++ (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.29 ++ (:external-format (prog1 ++ (with-open-file (s "foo.dat" :direction :output ++ :if-exists :supersede) ++ (stream-external-format s)) ++ (delete-all-versions "foo.dat") ++ )) ++ (progn (close s) ++ (with-open-file (is #p"tmp.dat") (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++;;; Default behavior of open :if-exists is :create when the version ++;;; of the filespec is :newest ++ ++(deftest open.output.30 ++ :notes (:open-if-exists-new-version-no-error) ++ (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest))) ++ (or (not (eql (pathname-version pn) :newest)) ++ (progn ++ ;; Create file ++ (let ((s1 (open pn :direction :output :if-exists :overwrite ++ :if-does-not-exist :create))) ++ (unwind-protect ++ ;; Now try again ++ (let ((s2 (open pn :direction :output))) ++ (unwind-protect ++ (write-line "abcdef" s2) ++ (close s2)) ++ (unwind-protect ++ (progn ++ (setq s2 (open s1 :direction :input)) ++ (equalt (read-line s2 nil) "abcdef")) ++ (close s2))) ++ (close s1) ++ (delete-all-versions pn) ++ ))))) ++ t) ++ ++(def-open-output-test open.output.31 (:if-exists :rename ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.32 (:if-exists :rename-and-delete ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.33 (:if-exists :new-version ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.34 (:if-exists :supersede ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++(def-open-output-test open.output.35 (:if-exists nil ++ :direction :output) ++ (progn (close s) ++ (with-open-file ++ (is pn :direction :input) ++ (values (read-line is nil)))) ++ ("abcdefghij")) ++ ++;;; Add -- tests for when the filespec is a stream ++ ++ ++;;; Tests of bidirectional IO ++ ++(defmacro def-open-io-test ++ (name args form expected ++ &rest keyargs ++ &key ++ (element-type 'character) ++ (build-form ++ `(dotimes (i 10) ++ ,(cond ++ ((subtypep element-type 'integer) ++ `(write-byte ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ s)) ++ ((subtypep element-type 'character) ++ `(write-char ++ (funcall (the function ++ (generator-for-element-type ',element-type)) i) ++ s))))) ++ &allow-other-keys) ++ `(def-open-test ,name (:direction :io ,@args) ++ (progn ++ ,build-form ++ (assert (input-stream-p s)) ++ (assert (output-stream-p s)) ++ ,form) ++ ,expected ++ :build-form nil ++ ,@keyargs)) ++ ++;; (compile 'def-open-io-test) ++ ++(def-open-io-test open.io.1 () ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.2 () ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij") ++ :pathname "tmp.dat") ++ ++(def-open-io-test open.io.3 ++ () ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij") ++ :pathname (logical-pathname "CLTEST:TMP.DAT")) ++ ++(def-open-io-test open.io.4 () ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij") ++ :element-type character) ++ ++(def-open-io-test open.io.5 () ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij") ++ :element-type base-char) ++ ++(def-open-io-test open.io.6 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type (integer 0 1)) ++ ++(def-open-io-test open.io.7 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type bit) ++ ++(def-open-io-test open.io.8 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 0 1 0 1 0 1 0 1)) ++ :element-type (unsigned-byte 1)) ++ ++(def-open-io-test open.io.9 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 0 1 2 3 0 1)) ++ :element-type (unsigned-byte 2)) ++ ++(def-open-io-test open.io.10 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 0 1)) ++ :element-type (unsigned-byte 3)) ++ ++(def-open-io-test open.io.11 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 4)) ++ ++ ++(def-open-io-test open.io.12 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 6)) ++ ++(def-open-io-test open.io.13 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 8)) ++ ++(def-open-io-test open.io.14 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 12)) ++ ++(def-open-io-test open.io.15 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 16)) ++ ++(def-open-io-test open.io.16 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 24)) ++ ++(def-open-io-test open.io.17 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 32)) ++ ++(def-open-io-test open.io.18 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 64)) ++ ++(def-open-io-test open.io.19 () ++ (progn (file-position s :start) ++ (let ((seq (make-array 10))) ++ (read-sequence seq s) ++ seq)) ++ (#(0 1 2 3 4 5 6 7 8 9)) ++ :element-type (unsigned-byte 100)) ++ ++(deftest open.io.20 ++ (let ((pn #p"tmp.dat")) ++ (with-open-file (s pn :direction :io :if-exists :supersede)) ++ (open pn :direction :io :if-exists nil)) ++ nil) ++ ++(def-open-test open.io.21 (:if-exists :new-version :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("wxyz") ++ :notes (:open-if-exists-new-version-no-error) ++ ) ++ ++(def-open-test open.io.22 (:if-exists :rename :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("wxyz")) ++ ++(def-open-test open.io.23 (:if-exists :rename-and-delete ++ :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("wxyz")) ++ ++(def-open-test open.io.24 (:if-exists :overwrite ++ :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("wxyzefghij")) ++ ++(def-open-test open.io.25 (:if-exists :append ++ :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghijwxyz")) ++ ++(def-open-test open.io.26 (:if-exists :supersede ++ :direction :io) ++ (progn (write-sequence "wxyz" s) ++ (file-position s :start) ++ (values (read-line s nil))) ++ ("wxyz")) ++ ++(def-open-io-test open.io.27 (:if-does-not-exist :create ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(deftest open.io.28 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :io :if-does-not-exist nil)) ++ nil) ++ ++(def-open-io-test open.io.28a (:external-format :default) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.29 ++ (:external-format (prog1 ++ (with-open-file (s "foo.dat" :direction :io ++ :if-exists :supersede) ++ (stream-external-format s)) ++ (delete-all-versions "foo.dat") ++ )) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++;;; Default behavior of open :if-exists is :create when the version ++;;; of the filespec is :newest ++ ++(deftest open.io.30 ++ :notes (:open-if-exists-new-version-no-error) ++ (let ((pn (make-pathname :name "tmp" :type "dat" :version :newest))) ++ (or (not (eql (pathname-version pn) :newest)) ++ (progn ++ ;; Create file ++ (let ((s1 (open pn :direction :io :if-exists :overwrite ++ :if-does-not-exist :create))) ++ (unwind-protect ++ ;; Now try again ++ (let ((s2 (open pn :direction :io))) ++ (unwind-protect ++ (write-line "abcdef" s2) ++ (close s2)) ++ (unwind-protect ++ (progn ++ (setq s2 (open s1 :direction :input)) ++ (equalt (read-line s2 nil) "abcdef")) ++ (close s2))) ++ (close s1) ++ (delete-all-versions pn) ++ ))))) ++ t) ++ ++(def-open-io-test open.io.31 (:if-exists :rename ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.32 (:if-exists :rename-and-delete ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.33 (:if-exists :new-version ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.34 (:if-exists :supersede ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++(def-open-io-test open.io.35 (:if-exists nil ++ :direction :io) ++ (progn (file-position s :start) ++ (values (read-line s nil))) ++ ("abcdefghij")) ++ ++;;;; :PROBE tests ++ ++(defmacro def-open-probe-test ++ (name args form ++ &key (build-form nil build-form-p) ++ (pathname #p"tmp.dat")) ++ (unless build-form-p ++ (setf build-form ++ `(with-open-file (s pn :direction :output ++ :if-exists :supersede)))) ++ `(deftest ,name ++ (let ((pn ,pathname)) ++ (delete-all-versions pn) ++ ,build-form ++ (let ((s (open pn :direction :probe ,@args))) ++ (values ++ ,(if build-form ++ `(and ++ (typep s 'file-stream) ++ (not (open-stream-p s)) ++ ) ++ `(not s)) ++ ,form))) ++ t t)) ++ ++(def-open-probe-test open.probe.1 () t) ++(def-open-probe-test open.probe.2 (:if-exists :error) t) ++(def-open-probe-test open.probe.3 (:if-exists :new-version) t) ++(def-open-probe-test open.probe.4 (:if-exists :rename) t) ++(def-open-probe-test open.probe.5 (:if-exists :rename-and-delete) t) ++(def-open-probe-test open.probe.6 (:if-exists :overwrite) t) ++(def-open-probe-test open.probe.7 (:if-exists :append) t) ++(def-open-probe-test open.probe.8 (:if-exists :supersede) t) ++ ++(def-open-probe-test open.probe.9 (:if-does-not-exist :error) t) ++(def-open-probe-test open.probe.10 (:if-does-not-exist nil) t) ++(def-open-probe-test open.probe.11 (:if-does-not-exist :create) t) ++ ++(def-open-probe-test open.probe.12 () t :build-form nil) ++(def-open-probe-test open.probe.13 (:if-exists :error) t :build-form nil) ++(def-open-probe-test open.probe.14 (:if-exists :new-version) t :build-form nil) ++(def-open-probe-test open.probe.15 (:if-exists :rename) t :build-form nil) ++(def-open-probe-test open.probe.16 (:if-exists :rename-and-delete) t ++ :build-form nil) ++(def-open-probe-test open.probe.17 (:if-exists :overwrite) t ++ :build-form nil) ++(def-open-probe-test open.probe.18 (:if-exists :append) t ++ :build-form nil) ++(def-open-probe-test open.probe.19 (:if-exists :supersede) t ++ :build-form nil) ++ ++(def-open-probe-test open.probe.20 (:if-does-not-exist nil) t ++ :build-form nil) ++ ++(deftest open.probe.21 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (let ((s (open pn :direction :probe :if-does-not-exist :create))) ++ (values ++ (notnot s) ++ (notnot (probe-file pn))))) ++ t t) ++ ++(deftest open.probe.22 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (let ((s (open pn :direction :probe :if-does-not-exist :create ++ :if-exists :error))) ++ (values ++ (notnot s) ++ (notnot (probe-file pn))))) ++ t t) ++ ++(def-open-probe-test open.probe.23 (:external-format :default) t) ++(def-open-probe-test open.probe.24 (:element-type 'character) t) ++(def-open-probe-test open.probe.25 (:element-type 'bit) t) ++(def-open-probe-test open.probe.26 (:element-type '(unsigned-byte 2)) t) ++(def-open-probe-test open.probe.27 (:element-type '(unsigned-byte 4)) t) ++(def-open-probe-test open.probe.28 (:element-type '(unsigned-byte 8)) t) ++(def-open-probe-test open.probe.29 (:element-type '(unsigned-byte 9)) t) ++(def-open-probe-test open.probe.30 (:element-type '(unsigned-byte 15)) t) ++(def-open-probe-test open.probe.31 (:element-type '(unsigned-byte 16)) t) ++(def-open-probe-test open.probe.32 (:element-type '(unsigned-byte 17)) t) ++(def-open-probe-test open.probe.33 (:element-type '(unsigned-byte 31)) t) ++(def-open-probe-test open.probe.34 (:element-type '(unsigned-byte 32)) t) ++(def-open-probe-test open.probe.35 (:element-type '(unsigned-byte 33)) t) ++(def-open-probe-test open.probe.36 (:element-type '(integer -1002 13112)) t) ++ ++;;;; Error tests ++ ++(deftest open.error.1 ++ (signals-error (open) program-error) ++ t) ++ ++(deftest open.error.2 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (close (open pn :direction :output :if-does-not-exist :create)) ++ (open pn :if-exists :error :direction :output)) ++ file-error) ++ t t) ++ ++(deftest open.error.3 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (close (open pn :direction :output :if-does-not-exist :create)) ++ (open pn :if-exists :error :direction :io)) ++ file-error) ++ t t) ++ ++(deftest open.error.4 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn)) ++ file-error) ++ t t) ++ ++(deftest open.error.5 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :if-does-not-exist :error)) ++ file-error) ++ t t) ++ ++(deftest open.error.6 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :input)) ++ file-error) ++ t t) ++ ++(deftest open.error.7 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :if-does-not-exist :error :direction :input)) ++ file-error) ++ t t) ++ ++(deftest open.error.8 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :output :if-does-not-exist :error)) ++ file-error) ++ t t) ++ ++(deftest open.error.9 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :io :if-does-not-exist :error)) ++ file-error) ++ t t) ++ ++(deftest open.error.10 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :probe :if-does-not-exist :error)) ++ file-error) ++ t t) ++ ++(deftest open.error.11 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :output :if-exists :overwrite)) ++ file-error) ++ t t) ++ ++(deftest open.error.12 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :output :if-exists :append)) ++ file-error) ++ t t) ++ ++(deftest open.error.13 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :io :if-exists :overwrite)) ++ file-error) ++ t t) ++ ++(deftest open.error.14 ++ (signals-error-always ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (open pn :direction :io :if-exists :append)) ++ file-error) ++ t t) ++ ++(deftest open.error.15 ++ (signals-error-always ++ (open (make-pathname :name :wild :type "lsp")) ++ file-error) ++ t t) ++ ++(deftest open.error.16 ++ (signals-error-always ++ (open (make-pathname :name "open" :type :wild)) ++ file-error) ++ t t) ++ ++(deftest open.error.17 ++ (signals-error-always ++ (let ((pn (make-pathname :name "open" :type "lsp" :version :wild))) ++ (if (wild-pathname-p pn) (open pn) ++ (error 'file-error))) ++ file-error) ++ t t) ++ ++(deftest open.error.18 ++ (signals-error-always ++ (open #p"tmp.dat" :direction :output :if-exists :supersede ++ :external-form (gensym)) ++ error) ++ t t) ++ ++ ++;;; FIXME -- add tests for :element-type :default ++ ++;;; FIXME -- add tests for filespec being a specialized string +--- /dev/null ++++ gcl-2.6.12/ansi-tests/output-stream-p.lsp +@@ -0,0 +1,39 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 19:46:12 2004 ++;;;; Contains: Tests of OUTPUT-STREAM-P ++ ++(in-package :cl-test) ++ ++(deftest output-stream-p.1 ++ (notnot-mv (output-stream-p *standard-output*)) ++ t) ++ ++(deftest output-stream-p.2 ++ (notnot-mv (output-stream-p *terminal-io*)) ++ t) ++ ++(deftest output-stream-p.3 ++ (with-open-file (s "output-stream-p.lsp" :direction :input) ++ (output-stream-p s)) ++ nil) ++ ++(deftest output-stream-p.4 ++ (with-open-file (s "foo.txt" :direction :output ++ :if-exists :supersede) ++ (notnot-mv (output-stream-p s))) ++ t) ++ ++;;; Error tests ++ ++(deftest output-stream-p.error.1 ++ (signals-error (output-stream-p) program-error) ++ t) ++ ++(deftest output-stream-p.error.2 ++ (signals-error (output-stream-p *standard-output* nil) program-error) ++ t) ++ ++(deftest output-stream-p.error.3 ++ (check-type-error #'output-stream-p #'streamp) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/parse-namestring.lsp +@@ -0,0 +1,89 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Aug 14 13:59:18 2004 ++;;;; Contains: Tests of PARSE-NAMESTRING ++ ++(in-package :cl-test) ++ ++;;; "Parsing a null string always succeeds, producing a pathname ++;;; with all components (except the host) equal to nil." ++ ++(deftest parse-namestring.1 ++ (let ((vals (multiple-value-list (parse-namestring "")))) ++ (assert (= (length vals) 2)) ++ (let ((pn (first vals)) ++ (pos (second vals))) ++ (values ++ (pathname-directory pn) ++ (pathname-device pn) ++ (pathname-name pn) ++ (pathname-type pn) ++ (pathname-version pn) ++ pos))) ++ nil nil nil nil nil 0) ++ ++(deftest parse-namestring.2 ++ (let ((vals (multiple-value-list (parse-namestring (make-array 0 :element-type 'base-char))))) ++ (assert (= (length vals) 2)) ++ (let ((pn (first vals)) ++ (pos (second vals))) ++ (values ++ (pathname-directory pn) ++ (pathname-device pn) ++ (pathname-name pn) ++ (pathname-type pn) ++ (pathname-version pn) ++ pos))) ++ nil nil nil nil nil 0) ++ ++(deftest parse-namestring.3 ++ (let ((vals (multiple-value-list (parse-namestring (make-array 4 :element-type 'base-char ++ :initial-element #\X ++ :fill-pointer 0))))) ++ (assert (= (length vals) 2)) ++ (let ((pn (first vals)) ++ (pos (second vals))) ++ (values ++ (pathname-directory pn) ++ (pathname-device pn) ++ (pathname-name pn) ++ (pathname-type pn) ++ (pathname-version pn) ++ pos))) ++ nil nil nil nil nil 0) ++ ++(deftest parse-namestring.4 ++ (loop for etype in '(standard-char base-char character) ++ for s0 = (make-array 4 :element-type etype :initial-element #\X) ++ for s = (make-array 0 :element-type etype :displaced-to s0 ++ :displaced-index-offset 1) ++ for vals = (multiple-value-list (parse-namestring s)) ++ for pn = (first vals) ++ for pos = (second vals) ++ do (assert (= (length vals) 2)) ++ nconc ++ (let ((result (list (pathname-directory pn) ++ (pathname-device pn) ++ (pathname-name pn) ++ (pathname-type pn) ++ (pathname-version pn) ++ pos))) ++ (unless (equal result '(nil nil nil nil nil 0)) ++ (list (list etype result))))) ++ nil) ++ ++;;; Error tests ++ ++(deftest parse-namestring.error.1 ++ (signals-error (parse-namestring) program-error) ++ t) ++ ++(deftest parse-name-string.error.2 ++ (signals-error (parse-namestring "" nil *default-pathname-defaults* :foo nil) program-error) ++ t) ++ ++(deftest parse-name-string.error.3 ++ (signals-error (parse-namestring "" nil *default-pathname-defaults* :start) program-error) ++ t) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-device.lsp +@@ -0,0 +1,74 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:23:54 2003 ++;;;; Contains: Tests for PATHNAME-DEVICE ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-device.1 ++ (loop for p in *pathnames* ++ for device = (pathname-device p) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++(deftest pathname-device.2 ++ (loop for p in *pathnames* ++ for device = (pathname-device p :case :local) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++(deftest pathname-device.3 ++ (loop for p in *pathnames* ++ for device = (pathname-device p :case :common) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++(deftest pathname-device.4 ++ (loop for p in *pathnames* ++ for device = (pathname-device p :allow-other-keys nil) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++(deftest pathname-device.5 ++ (loop for p in *pathnames* ++ for device = (pathname-device p :foo 'bar :allow-other-keys t) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++(deftest pathname-device.6 ++ (loop for p in *pathnames* ++ for device = (pathname-device p :allow-other-keys t :allow-other-keys nil :foo 'bar) ++ unless (or (stringp device) ++ (member device '(nil :wild :unspecific))) ++ collect (list p device)) ++ nil) ++ ++;;; section 19.3.2.1 ++(deftest pathname-device.7 ++ (loop for p in *logical-pathnames* ++ always (eq (pathname-device p) :unspecific)) ++ t) ++ ++(deftest pathname-device.8 ++ (do-special-strings (s "" nil) (pathname-device s)) ++ nil) ++ ++(deftest pathname-device.error.1 ++ (signals-error (pathname-device) program-error) ++ t) ++ ++(deftest pathname-device.error.2 ++ (check-type-error #'pathname-device #'could-be-pathname-designator) ++ nil) +\ No newline at end of file +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-directory.lsp +@@ -0,0 +1,89 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:24:39 2003 ++;;;; Contains: Tests for PATHNAME-DIRECTORY ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-directory.1 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++(deftest pathname-directory.2 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p :case :local) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++(deftest pathname-directory.3 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p :case :common) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++(deftest pathname-directory.4 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p :allow-other-keys nil) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++(deftest pathname-directory.5 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p :foo 'bar :allow-other-keys t) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++(deftest pathname-directory.6 ++ (loop for p in *pathnames* ++ for directory = (pathname-directory p :allow-other-keys t ++ :allow-other-keys nil ++ 'foo 'bar) ++ unless (or (stringp directory) ++ (member directory '(nil :wild :unspecific)) ++ (and (consp directory) ++ (member (car directory) '(:absolute :relative)))) ++ collect (list p directory)) ++ nil) ++ ++;;; section 19.3.2.1 ++(deftest pathname-directory.7 ++ (loop for p in *logical-pathnames* ++ when (eq (pathname-directory p) :unspecific) ++ collect p) ++ nil) ++ ++(deftest pathname-directory.8 ++ (do-special-strings (s "" nil) (pathname-directory s)) ++ nil) ++ ++(deftest pathname-directory.error.1 ++ (signals-error (pathname-directory) program-error) ++ t) ++ ++(deftest pathname-directory.error.2 ++ (check-type-error #'pathname-directory #'could-be-pathname-designator) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-host.lsp +@@ -0,0 +1,79 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:23:22 2003 ++;;;; Contains: Tests for PATHNAME-HOST ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-host.1 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list (pathname-host p))) 1)) ++ t) ++ ++(deftest pathname-host.2 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list (pathname-host p :case :local))) 1)) ++ t) ++ ++(deftest pathname-host.3 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list (pathname-host p :case :common))) 1)) ++ t) ++ ++(deftest pathname-host.4 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list (pathname-host p :allow-other-keys nil))) 1)) ++ t) ++ ++(deftest pathname-host.5 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list ++ (pathname-host p :foo t :allow-other-keys t))) 1)) ++ t) ++ ++(deftest pathname-host.6 ++ (loop for p in *pathnames* ++ always (eql (length (multiple-value-list ++ (pathname-host p :allow-other-keys t ++ :allow-other-keys nil ++ 'foo t))) 1)) ++ t) ++ ++;;; section 19.3.2.1 ++(deftest pathname-host.7 ++ (loop for p in *logical-pathnames* ++ when (eq (pathname-host p) :unspecific) ++ collect p) ++ nil) ++ ++(deftest pathname-host.8 ++ (do-special-strings (s "" nil) (pathname-host s)) ++ nil) ++ ++#| ++(deftest pathname-host.9 ++ (loop for p in *pathnames* ++ for host = (pathname-host p) ++ unless (or (stringp host) ++ (and (listp host) (every #'stringp host)) ++ (eql host :unspecific)) ++ collect (list p host)) ++ nil) ++|# ++ ++;;; Error cases ++ ++(deftest pathname-host.error.1 ++ (signals-error (pathname-host) program-error) ++ t) ++ ++(deftest pathname-host.error.2 ++ (check-type-error #'pathname-host #'could-be-pathname-designator) ++ nil) ++ ++(deftest pathname-host.error.3 ++ (signals-error (pathname-host *default-pathname-defaults* '#:bogus t) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-match-p.lsp +@@ -0,0 +1,103 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Aug 15 07:46:22 2004 ++;;;; Contains: Tests for PATHNAME-MATCH-P ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++;;; Much of the behavior cannot be tested portably. ++ ++(deftest pathname-match-p.1 ++ (let ((pn1 (make-pathname :name :wild)) ++ (pn2 (make-pathname :name "foo"))) ++ (pathname-match-p pn1 pn2)) ++ nil) ++ ++(deftest pathname-match-p.2 ++ (let ((pn1 (make-pathname :type :wild)) ++ (pn2 (make-pathname :type "txt"))) ++ (pathname-match-p pn1 pn2)) ++ nil) ++ ++(deftest pathname-match-p.3 ++ (let ((pn1 (make-pathname :directory '(:absolute :wild))) ++ (pn2 (make-pathname :directory '(:absolute)))) ++ (pathname-match-p pn1 pn2)) ++ nil) ++ ++(deftest pathname-match-p.4 ++ (let ((pn1 (make-pathname :directory '(:relative :wild))) ++ (pn2 (make-pathname :directory '(:relative)))) ++ (pathname-match-p pn1 pn2)) ++ nil) ++ ++(deftest pathname-match-p.5 ++ (let ((pn1 (make-pathname :directory '(:relative :wild))) ++ (pn2 (make-pathname :directory nil))) ++ (and (wild-pathname-p pn1) ++ (not (pathname-directory pn2)) ++ (not (pathname-match-p pn1 pn2)))) ++ nil) ++ ++(deftest pathname-match-p.6 ++ (let ((pn1 (make-pathname :version :wild)) ++ (pn2 (make-pathname))) ++ (and (wild-pathname-p pn1) ++ (not (pathname-version pn2)) ++ (not (pathname-match-p pn1 pn2)))) ++ nil) ++ ++;;; Specialized string tests ++ ++(deftest pathname-match-p.7 ++ (let ((wpn (parse-namestring "CLTEST:*.LSP"))) ++ (assert (wild-pathname-p wpn)) ++ (do-special-strings ++ (s "CLTEST:FOO.LSP" nil) ++ (assert (pathname-match-p s wpn)))) ++ nil) ++ ++(deftest pathname-match-p.8 ++ (do-special-strings ++ (s "CLTEST:*.LSP" nil) ++ (assert (pathname-match-p "CLTEST:FOO.LSP" s))) ++ nil) ++ ++ ++;;; Add more tests here ++ ++;;; Here are error tests ++ ++(deftest pathname-match-p.error.1 ++ (signals-error (pathname-match-p) program-error) ++ t) ++ ++(deftest pathname-match-p.error.2 ++ (signals-error (pathname-match-p #p"") program-error) ++ t) ++ ++(deftest pathname-match-p.error.3 ++ (signals-error (pathname-match-p #p"" #p"" nil) program-error) ++ t) ++ ++(deftest pathname-match-p.error.4 ++ (check-type-error #'(lambda (x) (pathname-match-p x #p"")) ++ #'could-be-pathname-designator) ++ nil) ++ ++(deftest pathname-match-p.error.5 ++ (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pathname-match-p x #p"")) ++ #'could-be-pathname-designator) ++ nil) ++ ++(deftest pathname-match-p.error.6 ++ (check-type-error #'(lambda (x) (pathname-match-p #p"" x)) ++ #'could-be-pathname-designator) ++ nil) ++ ++(deftest pathname-match-p.error.7 ++ (check-type-error #'(lambda (x) (declare (optimize (safety 0))) (pathname-match-p #p"" x)) ++ #'could-be-pathname-designator) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-name.lsp +@@ -0,0 +1,75 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:45:16 2003 ++;;;; Contains: Tests for PATHNAME-NAME ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-name.1 ++ (loop for p in *pathnames* ++ for name = (pathname-name p) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++(deftest pathname-name.2 ++ (loop for p in *pathnames* ++ for name = (pathname-name p :case :local) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++(deftest pathname-name.3 ++ (loop for p in *pathnames* ++ for name = (pathname-name p :case :common) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++(deftest pathname-name.4 ++ (loop for p in *pathnames* ++ for name = (pathname-name p :allow-other-keys nil) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++(deftest pathname-name.5 ++ (loop for p in *pathnames* ++ for name = (pathname-name p :foo 'bar :allow-other-keys t) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++(deftest pathname-name.6 ++ (loop for p in *pathnames* ++ for name = (pathname-name p :allow-other-keys t :allow-other-keys nil :foo 'bar) ++ unless (or (stringp name) ++ (member name '(nil :wild :unspecific))) ++ collect (list p name)) ++ nil) ++ ++;;; section 19.3.2.1 ++(deftest pathname-name.7 ++ (loop for p in *logical-pathnames* ++ when (eq (pathname-name p) :unspecific) ++ collect p) ++ nil) ++ ++(deftest pathname-name.8 ++ (do-special-strings (s "" nil) (pathname-name s)) ++ nil) ++ ++(deftest pathname-name.error.1 ++ (signals-error (pathname-name) program-error) ++ t) ++ ++(deftest pathname-name.error.2 ++ (check-type-error #'pathname-name #'could-be-pathname-designator) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-type.lsp +@@ -0,0 +1,75 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:45:16 2003 ++;;;; Contains: Tests for PATHNAME-TYPE ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-type.1 ++ (loop for p in *pathnames* ++ for type = (pathname-type p) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++(deftest pathname-type.2 ++ (loop for p in *pathnames* ++ for type = (pathname-type p :case :local) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++(deftest pathname-type.3 ++ (loop for p in *pathnames* ++ for type = (pathname-type p :case :common) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++(deftest pathname-type.4 ++ (loop for p in *pathnames* ++ for type = (pathname-type p :allow-other-keys nil) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++(deftest pathname-type.5 ++ (loop for p in *pathnames* ++ for type = (pathname-type p :foo 'bar :allow-other-keys t) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++(deftest pathname-type.6 ++ (loop for p in *pathnames* ++ for type = (pathname-type p :allow-other-keys t :allow-other-keys nil :foo 'bar) ++ unless (or (stringp type) ++ (member type '(nil :wild :unspecific))) ++ collect (list p type)) ++ nil) ++ ++;;; section 19.3.2.1 ++(deftest pathname-type.7 ++ (loop for p in *logical-pathnames* ++ when (eq (pathname-type p) :unspecific) ++ collect p) ++ nil) ++ ++(deftest pathname-type.8 ++ (do-special-strings (s "" nil) (pathname-type s)) ++ nil) ++ ++(deftest pathname-type.error.1 ++ (signals-error (pathname-type) program-error) ++ t) ++ ++(deftest pathname-type.error.2 ++ (check-type-error #'pathname-type #'could-be-pathname-designator) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname-version.lsp +@@ -0,0 +1,40 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 14:45:16 2003 ++;;;; Contains: Tests for PATHNAME-VERSION ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest pathname-version.1 ++ (loop for p in *pathnames* ++ for version = (pathname-version p) ++ unless (or (integerp version) (symbolp version)) ++ collect (list p version)) ++ nil) ++ ++;;; section 19.3.2.1 ++(deftest pathname-version.2 ++ (loop for p in *logical-pathnames* ++ when (eq (pathname-version p) :unspecific) ++ collect p) ++ nil) ++ ++(deftest pathname-version.3 ++ (do-special-strings (s "" nil) (pathname-version s)) ++ nil) ++ ++(deftest pathname-version.error.1 ++ (signals-error (pathname-version) program-error) ++ t) ++ ++(deftest pathname-version.error.2 ++ (signals-error (pathname-version *default-pathname-defaults* nil) ++ program-error) ++ t) ++ ++(deftest pathname-version.error.3 ++ (check-type-error #'pathname-version #'could-be-pathname-designator) ++ nil) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathname.lsp +@@ -0,0 +1,88 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Nov 29 05:06:57 2003 ++;;;; Contains: Tests of the function PATHNAME ++ ++(in-package :cl-test) ++ ++(deftest pathname.1 ++ (loop for x in *pathnames* ++ always (eq x (pathname x))) ++ t) ++ ++(deftest pathname.2 ++ (equalt #p"ansi-aux.lsp" (pathname "ansi-aux.lsp")) ++ t) ++ ++(deftest pathname.3 ++ (let ((s (open "ansi-aux.lsp" :direction :input))) ++ (prog1 (equalt (truename (pathname s)) (truename #p"ansi-aux.lsp")) ++ (close s))) ++ t) ++ ++(deftest pathname.4 ++ (let ((s (open "ansi-aux.lsp" :direction :input))) ++ (close s) ++ (equalt (truename (pathname s)) (truename #p"ansi-aux.lsp"))) ++ t) ++ ++(deftest pathname.5 ++ (loop for x in *logical-pathnames* ++ always (eq x (pathname x))) ++ t) ++ ++(deftest pathname.6 ++ (equalt #p"ansi-aux.lsp" ++ (pathname (make-array 12 :initial-contents "ansi-aux.lsp" ++ :element-type 'base-char))) ++ t) ++ ++(deftest pathname.7 ++ (equalt #p"ansi-aux.lsp" ++ (pathname (make-array 15 :initial-contents "ansi-aux.lspXXX" ++ :element-type 'base-char ++ :fill-pointer 12))) ++ t) ++ ++(deftest pathname.8 ++ (equalt #p"ansi-aux.lsp" ++ (pathname (make-array 12 :initial-contents "ansi-aux.lsp" ++ :element-type 'base-char ++ :adjustable t))) ++ t) ++ ++(deftest pathname.9 ++ (equalt #p"ansi-aux.lsp" ++ (pathname (make-array 15 :initial-contents "ansi-aux.lspXXX" ++ :element-type 'character ++ :fill-pointer 12))) ++ t) ++ ++(deftest pathname.10 ++ (equalt #p"ansi-aux.lsp" ++ (pathname (make-array 12 :initial-contents "ansi-aux.lsp" ++ :element-type 'character ++ :adjustable t))) ++ t) ++ ++(deftest pathname.11 ++ (loop for etype in '(standard-char base-char character) ++ collect ++ (equalt #p"ansi-aux.lsp" ++ (pathname ++ (let* ((s (make-array 15 :initial-contents "XXansi-aux.lspX" ++ :element-type etype))) ++ (make-array 12 :element-type etype ++ :displaced-to s ++ :displaced-index-offset 2))))) ++ (t t t)) ++ ++;;; Error tests ++ ++(deftest pathname.error.1 ++ (signals-error (pathname) program-error) ++ t) ++ ++(deftest pathname.error.2 ++ (signals-error (pathname (first *pathnames*) nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathnamep.lsp +@@ -0,0 +1,31 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 10:26:45 2003 ++;;;; Contains: Tests of PATHNAMEP ++ ++(in-package :cl-test) ++ ++(deftest pathnamep.1 ++ (check-type-predicate #'pathnamep 'pathname) ++ 0) ++ ++(deftest pathnamep.2 ++ (check-predicate #'(lambda (x) (eql (length (multiple-value-list (pathnamep x))) 1))) ++ nil) ++ ++(deftest pathnamep.3 ++ (check-predicate (typef '(not logical-pathname)) #'pathnamep) ++ nil) ++ ++(deftest pathnamep.error.1 ++ (signals-error (pathnamep) program-error) ++ t) ++ ++(deftest pathnamep.error.2 ++ (signals-error (pathnamep nil nil) program-error) ++ t) ++ ++(deftest pathnamep.error.3 ++ (signals-error (pathnamep *default-pathname-defaults* nil) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathnames-aux.lsp +@@ -0,0 +1,25 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Dec 6 15:05:05 2003 ++;;;; Contains: Functions associated with pathname tests ++ ++(in-package :cl-test) ++ ++(defun could-be-pathname-designator (x) ++ (or (stringp x) ++ (pathnamep x) ++ (typep x 'file-stream) ++ (and (typep x 'synonym-stream) ++ (could-be-pathname-designator ++ (symbol-value ++ (synonym-stream-symbol x)))))) ++ ++(defun explode-pathname (pn) ++ (list ++ :host (pathname-host pn) ++ :device (pathname-device pn) ++ :directory (pathname-directory pn) ++ :name (pathname-name pn) ++ :type (pathname-type pn) ++ :version (pathname-version pn))) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/pathnames.lsp +@@ -0,0 +1,19 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Nov 29 04:21:53 2003 ++;;;; Contains: Various tests on pathnames ++ ++(in-package :cl-test) ++ ++(deftest pathnames-print-and-read-properly ++ (with-standard-io-syntax ++ (loop ++ for p1 in *pathnames* ++ for s = (handler-case (write-to-string p1 :readably t) ++ (print-not-readable () :unreadable-error)) ++ unless (eql s :unreadable-error) ++ append ++ (let ((p2 (read-from-string s))) ++ (unless (equal p1 p2) ++ (list (list p1 s p2)))))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/peek-char.lsp +@@ -0,0 +1,329 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Jan 17 21:02:13 2004 ++;;;; Contains: Tests of PEEK-CHAR ++ ++(in-package :cl-test) ++ ++(deftest peek-char.1 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (values ++ (peek-char) ++ (read-char) ++ (read-char) ++ (peek-char) ++ (read-char))) ++ #\a #\a #\b #\c #\c) ++ ++(deftest peek-char.2 ++ (with-input-from-string ++ (*standard-input* " ab") ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #\Space #\Space #\a #\a #\b #\b) ++ ++(deftest peek-char.3 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ (string #\Newline) ++ (string #\Newline) ++ " " ++ (string #\Newline) ++ "ab")) ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #\Newline #\Newline #\a #\a #\b #\b) ++ ++(when (name-char "Linefeed") ++ (deftest peek-char.4 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ (string (name-char "Linefeed")) ++ (string (name-char "Linefeed")) ++ "abc")) ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #.(name-char "Linefeed") ++ #.(name-char "Linefeed") ++ #\a #\a)) ++ ++(when (name-char "Page") ++ (deftest peek-char.5 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ (string (name-char "Page")) ++ (string (name-char "Page")) ++ "abc")) ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #.(name-char "Page") ++ #.(name-char "Page") ++ #\a #\a)) ++ ++(when (name-char "Tab") ++ (deftest peek-char.6 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ (string (name-char "Tab")) ++ (string (name-char "Tab")) ++ "abc")) ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #.(name-char "Tab") ++ #.(name-char "Tab") ++ #\a #\a)) ++ ++(when (name-char "Return") ++ (deftest peek-char.7 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ (string (name-char "Return")) ++ (string (name-char "Return")) ++ "abc")) ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char))) ++ #.(name-char "Return") ++ #.(name-char "Return") ++ #\a #\a)) ++ ++(deftest peek-char.8 ++ (with-input-from-string ++ (s "a bcd") ++ (values ++ (peek-char nil s) ++ (read-char s) ++ (peek-char t s) ++ (read-char s) ++ (peek-char t s) ++ (read-char s))) ++ #\a #\a #\b #\b #\c #\c) ++ ++(deftest peek-char.9 ++ (with-input-from-string ++ (*standard-input* " a bCcde") ++ (values ++ (peek-char #\c) ++ (read-char) ++ (read-char))) ++ #\c #\c #\d) ++ ++(deftest peek-char.10 ++ (with-input-from-string ++ (*standard-input* " ; foo") ++ (values ++ (peek-char t) ++ (read-char))) ++ #\; #\;) ++ ++(deftest peek-char.11 ++ (with-input-from-string ++ (s "") ++ (peek-char nil s nil)) ++ nil) ++ ++(deftest peek-char.12 ++ (with-input-from-string ++ (s "") ++ (peek-char nil s nil 'foo)) ++ foo) ++ ++(deftest peek-char.13 ++ (with-input-from-string ++ (s " ") ++ (peek-char t s nil)) ++ nil) ++ ++(deftest peek-char.14 ++ (with-input-from-string ++ (s " ") ++ (peek-char t s nil 'foo)) ++ foo) ++ ++(deftest peek-char.15 ++ (with-input-from-string ++ (s "ab c d") ++ (peek-char #\z s nil)) ++ nil) ++ ++(deftest peek-char.16 ++ (with-input-from-string ++ (s "ab c d") ++ (peek-char #\z s nil 'foo)) ++ foo) ++ ++;;; Interaction with echo streams ++ ++(deftest peek-char.17 ++ (block done ++ (with-input-from-string ++ (is "ab") ++ (with-output-to-string ++ (os) ++ (let ((es (make-echo-stream is os))) ++ (let ((pos1 (file-position os))) ++ (unless (zerop pos1) (return-from done :good)) ++ (peek-char nil es nil) ++ (let ((pos2 (file-position os))) ++ (return-from done ++ (if (eql pos1 pos2) ++ :good ++ (list pos1 pos2))))))))) ++ :good) ++ ++(deftest peek-char.18 ++ (block done ++ (with-input-from-string ++ (is " ab") ++ (with-output-to-string ++ (os) ++ (let ((es (make-echo-stream is os))) ++ (let ((pos1 (file-position os))) ++ (unless (zerop pos1) (return-from done :good)) ++ (peek-char t es nil) ++ (let ((pos2 (file-position os))) ++ (return-from done ++ (if (eql pos1 pos2) ++ pos1 ++ :good)))))))) ++ :good) ++ ++(deftest peek-char.19 ++ (block done ++ (with-input-from-string ++ (is "abcde") ++ (with-output-to-string ++ (os) ++ (let ((es (make-echo-stream is os))) ++ (let ((pos1 (file-position os))) ++ (unless (zerop pos1) (return-from done :good)) ++ (peek-char #\c es nil) ++ (let ((pos2 (file-position os))) ++ (return-from done ++ (if (eql pos1 pos2) ++ pos1 ++ :good)))))))) ++ :good) ++ ++;;; Interactions with the readtable ++ ++(deftest peek-char.20 ++ (let ((*readtable* (copy-readtable))) ++ (set-syntax-from-char #\Space #\a) ++ (with-input-from-string ++ (*standard-input* " x") ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char)))) ++ #\Space #\Space ++ #\Space #\Space ; *not* #\x #\x ++ ) ++ ++(deftest peek-char.21 ++ (let ((*readtable* (copy-readtable))) ++ (set-syntax-from-char #\x #\Space) ++ (with-input-from-string ++ (*standard-input* "xxa") ++ (values ++ (peek-char) ++ (read-char) ++ (peek-char t) ++ (read-char)))) ++ #\x #\x ++ #\a #\a ; *not* #\x #\x ++ ) ++ ++;;; Stream designators are accepted for the stream argument ++ ++(deftest peek-char.22 ++ (with-input-from-string ++ (is "!?*") ++ (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) ++ (peek-char nil t))) ++ #\!) ++ ++(deftest peek-char.23 ++ (with-input-from-string ++ (*standard-input* "345") ++ (peek-char nil nil)) ++ #\3) ++ ++;;; Error tests ++ ++(deftest peek-char.error.1 ++ (signals-error ++ (with-input-from-string ++ (s "abc") ++ (peek-char s nil nil nil nil 'nonsense)) ++ program-error) ++ t) ++ ++ ++(deftest peek-char.error.2 ++ (signals-error-always ++ (with-input-from-string ++ (*standard-input* "") ++ (peek-char)) ++ end-of-file) ++ t t) ++ ++(deftest peek-char.error.3 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (peek-char nil s)) ++ end-of-file) ++ t t) ++ ++(deftest peek-char.error.4 ++ (signals-error-always ++ (with-input-from-string ++ (s " ") ++ (peek-char t s)) ++ end-of-file) ++ t t) ++ ++(deftest peek-char.error.5 ++ (signals-error-always ++ (with-input-from-string ++ (s "abcd") ++ (peek-char #\z s)) ++ end-of-file) ++ t t) ++ ++;;; There was a consensus on comp.lang.lisp that the requirement ++;;; that an end-of-file error be thrown in the following case ++;;; is a spec bug ++#| ++(deftest peek-char.error.6 ++ (signals-error ++ (with-input-from-string ++ (s "") ++ (peek-char nil s nil nil t)) ++ end-of-file) ++ t) ++|# +--- /dev/null ++++ gcl-2.6.12/ansi-tests/probe-file.lsp +@@ -0,0 +1,58 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Jan 5 20:46:29 2004 ++;;;; Contains: Tests of PROBE-FILE ++ ++(in-package :cl-test) ++ ++(deftest probe-file.1 ++ (probe-file #p"nonexistent") ++ nil) ++ ++(deftest probe-file.2 ++ (let ((s (open #p"probe-file.lsp" :direction :input))) ++ (prog1 ++ (equalpt (truename #p"probe-file.lsp") ++ (probe-file s)) ++ (close s))) ++ t) ++ ++(deftest probe-file.3 ++ (let ((s (open #p"probe-file.lsp" :direction :input))) ++ (close s) ++ (equalpt (truename #p"probe-file.lsp") ++ (probe-file s))) ++ t) ++ ++(deftest probe-file.4 ++ (equalpt (truename #p"probe-file.lsp") ++ (probe-file "CLTEST:PROBE-FILE.LSP")) ++ t) ++ ++;;; Specialized string tests ++ ++(deftest probe-file.5 ++ (do-special-strings ++ (str "probe-file.lsp" nil) ++ (let ((s (open str :direction :input))) ++ (assert (equalpt (truename #p"probe-file.lsp") (probe-file s))) ++ (close s))) ++ nil) ++ ++;;; Error tests ++ ++(deftest probe-file.error.1 ++ (signals-error (probe-file) program-error) ++ t) ++ ++(deftest probe-file.error.2 ++ (signals-error (probe-file #p"probe-file.lsp" nil) program-error) ++ t) ++ ++(deftest probe-file.error.3 ++ (signals-error-always (probe-file (make-pathname :name :wild)) file-error) ++ t t) ++ ++(deftest probe-file.error.4 ++ (signals-error-always (probe-file "CLTEST:*.FOO") file-error) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/read-byte.lsp +@@ -0,0 +1,194 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Jan 17 17:30:49 2004 ++;;;; Contains: Tests of READ-BYTE, WRITE-BYTE ++ ++(in-package :cl-test) ++ ++(deftest read-byte.1 ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type '(unsigned-byte 8)))) ++ (values ++ (write-byte 17 s) ++ (close s) ++ (progn ++ (setq s (open "foo.txt" ++ :direction :input ++ :element-type '(unsigned-byte 8))) ++ (read-byte s)) ++ (close s))) ++ 17 t 17 t) ++ ++(deftest read-byte.2 ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type '(unsigned-byte 8)))) ++ (values ++ (close s) ++ (progn ++ (setq s (open "foo.txt" ++ :direction :input ++ :element-type '(unsigned-byte 8))) ++ (read-byte s nil 'foo)) ++ (read-byte s nil) ++ (close s))) ++ t foo nil t) ++ ++(deftest read-byte.3 ++ (loop with b1 = 0 ++ and b2 = 0 ++ for i from 1 to 32 ++ do (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type `(unsigned-byte ,i)))) ++ (write-byte (1- (ash 1 i)) s) ++ (write-byte 1 s) ++ (close s)) ++ unless (let ((s (open "foo.txt" ++ :direction :input ++ :element-type `(unsigned-byte ,i)))) ++ (prog1 ++ (and (eql (setq b1 (read-byte s)) (1- (ash 1 i))) ++ (eql (setq b2 (read-byte s)) 1)) ++ (close s))) ++ collect (list i b1 b2)) ++ nil) ++ ++(deftest read-byte.4 ++ (loop with b1 = 0 ++ and b2 = 0 ++ for i from 33 to 200 by 7 ++ do (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type `(unsigned-byte ,i)))) ++ (write-byte (1- (ash 1 i)) s) ++ (write-byte 1 s) ++ (close s)) ++ unless (let ((s (open "foo.txt" ++ :direction :input ++ :element-type `(unsigned-byte ,i)))) ++ (prog1 ++ (and (eql (setq b1 (read-byte s)) (1- (ash 1 i))) ++ (eql (setq b2 (read-byte s)) 1)) ++ (close s))) ++ collect (list i b1 b2)) ++ nil) ++ ++;;; Error tests ++ ++(deftest read-byte.error.1 ++ (signals-error (read-byte) program-error) ++ t) ++ ++(deftest read-byte.error.2 ++ (progn ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type `(unsigned-byte 8)))) ++ (close s)) ++ (signals-error ++ (let ((s (open "foo.txt" ++ :direction :input ++ :element-type '(unsigned-byte 8)))) ++ (read-byte s)) ++ end-of-file)) ++ t) ++ ++(deftest read-byte.error.3 ++ (progn ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede))) ++ (close s)) ++ (signals-error ++ (let ((s (open "foo.txt" :direction :input))) ++ (unwind-protect ++ (read-byte s) ++ (close s))) ++ error)) ++ t) ++ ++(deftest read-byte.error.4 ++ (signals-error-always ++ (progn ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type '(unsigned-byte 8)))) ++ (close s)) ++ (let ((s (open "foo.txt" ++ :direction :input ++ :element-type '(unsigned-byte 8)))) ++ (unwind-protect ++ (read-byte s t) ++ (close s)))) ++ end-of-file) ++ t t) ++ ++(deftest read-byte.error.5 ++ (check-type-error #'read-byte #'streamp) ++ nil) ++ ++(deftest read-byte.error.6 ++ (progn ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type '(unsigned-byte 8)))) ++ (close s)) ++ (signals-error ++ (let ((s (open "foo.txt" ++ :direction :input ++ :element-type '(unsigned-byte 8)))) ++ (unwind-protect ++ (read-byte s t t nil) ++ (close s))) ++ program-error)) ++ t) ++ ++ ++(deftest write-byte.error.1 ++ (signals-error (write-byte) program-error) ++ t) ++ ++(deftest write-byte.error.2 ++ (signals-error (write-byte 0) program-error) ++ t) ++ ++(deftest write-byte.error.3 ++ (signals-error ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede ++ :element-type '(unsigned-byte 8)))) ++ (unwind-protect ++ (write 1 s nil) ++ (close s))) ++ program-error) ++ t) ++ ++(deftest write-byte.error.4 ++ (check-type-error #'(lambda (x) (write-byte 0 x)) #'streamp) ++ nil) ++ ++(deftest write-byte.error.5 ++ (signals-error ++ (let ((s (open "foo.txt" ++ :direction :output ++ :if-exists :supersede))) ++ (unwind-protect ++ (write 1 s) ++ (close s))) ++ error) ++ t) ++ ++ ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/read-char-no-hang.lsp +@@ -0,0 +1,123 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:32:38 2004 ++;;;; Contains: Tests of READ-CHAR-NO-HANG ++ ++(in-package :cl-test) ++ ++(deftest read-char-no-hang.1 ++ (with-input-from-string ++ (*standard-input* "a") ++ (read-char-no-hang)) ++ #\a) ++ ++(deftest read-char-no-hang.2 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (values ++ (read-char-no-hang) ++ (read-char-no-hang) ++ (read-char-no-hang))) ++ #\a #\b #\c) ++ ++(when (code-char 0) ++ (deftest read-char-no-hang.3 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ "a" ++ (string (code-char 0)) ++ "b")) ++ (values ++ (read-char-no-hang) ++ (read-char-no-hang) ++ (read-char-no-hang))) ++ #\a #.(code-char 0) #\b)) ++ ++(deftest read-char-no-hang.4 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char-no-hang s) ++ (read-char-no-hang s) ++ (read-char-no-hang s))) ++ #\a #\b #\c) ++ ++(deftest read-char-no-hang.5 ++ (with-input-from-string ++ (s "") ++ (read-char-no-hang s nil)) ++ nil) ++ ++(deftest read-char-no-hang.6 ++ (with-input-from-string ++ (s "") ++ (read-char-no-hang s nil 'foo)) ++ foo) ++ ++(deftest read-char-no-hang.7 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char-no-hang s nil nil) ++ (read-char-no-hang s nil nil) ++ (read-char-no-hang s nil nil))) ++ #\a #\b #\c) ++ ++(deftest read-char-no-hang.8 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char-no-hang s nil t) ++ (read-char-no-hang s nil t) ++ (read-char-no-hang s nil t))) ++ #\a #\b #\c) ++ ++(deftest read-char-no-hang.9 ++ (with-input-from-string ++ (is "!?*") ++ (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) ++ (read-char-no-hang t))) ++ #\!) ++ ++(deftest read-char-no-hang.10 ++ (with-input-from-string ++ (*standard-input* "345") ++ (read-char-no-hang nil)) ++ #\3) ++ ++;;; Need a test of the non-hanging. ++;;; This is hard to do portably. ++ ++;;; Error tests ++ ++(deftest read-char-no-hang.error.1 ++ (signals-error ++ (with-input-from-string ++ (s "abc") ++ (read-char-no-hang s nil nil nil nil)) ++ program-error) ++ t) ++ ++(deftest read-char-no-hang.error.2 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char-no-hang s)) ++ end-of-file) ++ t t) ++ ++(deftest read-char-no-hang.error.3 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char-no-hang s t)) ++ end-of-file) ++ t t) ++ ++(deftest read-char-no-hang.error.4 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char-no-hang s t t)) ++ end-of-file) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/read-char.lsp +@@ -0,0 +1,121 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 08:53:56 2004 ++;;;; Contains: Tests of READ-CHAR ++ ++(in-package :cl-test) ++ ++(deftest read-char.1 ++ (with-input-from-string ++ (*standard-input* "a") ++ (read-char)) ++ #\a) ++ ++(deftest read-char.2 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (values ++ (read-char) ++ (read-char) ++ (read-char))) ++ #\a #\b #\c) ++ ++(when (code-char 0) ++ (deftest read-char.3 ++ (with-input-from-string ++ (*standard-input* (concatenate 'string ++ "a" ++ (string (code-char 0)) ++ "b")) ++ (values ++ (read-char) ++ (read-char) ++ (read-char))) ++ #\a #.(code-char 0) #\b)) ++ ++(deftest read-char.4 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char s) ++ (read-char s) ++ (read-char s))) ++ #\a #\b #\c) ++ ++(deftest read-char.5 ++ (with-input-from-string ++ (s "") ++ (read-char s nil)) ++ nil) ++ ++(deftest read-char.6 ++ (with-input-from-string ++ (s "") ++ (read-char s nil 'foo)) ++ foo) ++ ++(deftest read-char.7 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char s nil nil) ++ (read-char s nil nil) ++ (read-char s nil nil))) ++ #\a #\b #\c) ++ ++(deftest read-char.8 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char s nil t) ++ (read-char s nil t) ++ (read-char s nil t))) ++ #\a #\b #\c) ++ ++(deftest read-char.9 ++ (with-input-from-string ++ (is "!?*") ++ (let ((*terminal-io* (make-two-way-stream is (make-string-output-stream)))) ++ (read-char t))) ++ #\!) ++ ++(deftest read-char.10 ++ (with-input-from-string ++ (*standard-input* "345") ++ (read-char nil)) ++ #\3) ++ ++ ++;;; Error tests ++ ++(deftest read-char.error.1 ++ (signals-error ++ (with-input-from-string ++ (s "abc") ++ (read-char s nil nil nil nil)) ++ program-error) ++ t) ++ ++(deftest read-char.error.2 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char s)) ++ end-of-file) ++ t t) ++ ++(deftest read-char.error.3 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char s t)) ++ end-of-file) ++ t t) ++ ++(deftest read-char.error.4 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-char s t t)) ++ end-of-file) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/read-line.lsp +@@ -0,0 +1,104 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:53:59 2004 ++;;;; Contains: Tests of READ-LINE ++ ++(in-package :cl-test) ++ ++(deftest read-line.1 ++ (with-input-from-string ++ (*standard-input* " abcd ") ++ (let ((vals (multiple-value-list (read-line)))) ++ (assert (= (length vals) 2)) ++ (values (first vals) (notnot (second vals))))) ++ " abcd " t) ++ ++(deftest read-line.2 ++ (with-input-from-string ++ (*standard-input* (string #\Newline)) ++ (read-line)) ++ "" nil) ++ ++(deftest read-line.3 ++ (with-input-from-string ++ (s (concatenate 'string "abc" (string #\Newline))) ++ (read-line s)) ++ "abc" nil) ++ ++(deftest read-line.4 ++ (with-input-from-string ++ (s "") ++ (let ((vals (multiple-value-list (read-line s nil)))) ++ (assert (= (length vals) 2)) ++ (values (first vals) (notnot (second vals))))) ++ nil t) ++ ++(deftest read-line.5 ++ (with-input-from-string ++ (s "") ++ (let ((vals (multiple-value-list (read-line s nil 'foo)))) ++ (assert (= (length vals) 2)) ++ (values (first vals) (notnot (second vals))))) ++ foo t) ++ ++(deftest read-line.6 ++ (with-input-from-string ++ (s " abcd ") ++ (let ((vals (multiple-value-list (read-line s t nil t)))) ++ (assert (= (length vals) 2)) ++ (values (first vals) (notnot (second vals))))) ++ " abcd " t) ++ ++(deftest read-line.7 ++ (with-input-from-string ++ (is "abc") ++ (let ((*terminal-io* (make-two-way-stream is *standard-output*))) ++ (let ((vals (multiple-value-list (read-line t)))) ++ (assert (= (length vals) 2)) ++ (assert (second vals)) ++ (first vals)))) ++ "abc") ++ ++(deftest read-line.8 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (let ((vals (multiple-value-list (read-line nil)))) ++ (assert (= (length vals) 2)) ++ (assert (second vals)) ++ (first vals))) ++ "abc") ++ ++;;; Error tests ++ ++(deftest read-line.error.1 ++ (signals-error ++ (with-input-from-string ++ (s (concatenate 'string "abc" (string #\Newline))) ++ (read-line s t nil nil nil)) ++ program-error) ++ t) ++ ++(deftest read-line.error.2 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-line s)) ++ end-of-file) ++ t t) ++ ++(deftest read-line.error.3 ++ (signals-error-always ++ (with-input-from-string ++ (*standard-input* "") ++ (read-line)) ++ end-of-file) ++ t t) ++ ++(deftest read-line.error.4 ++ (signals-error-always ++ (with-input-from-string ++ (s "") ++ (read-line s t)) ++ end-of-file) ++ t t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/read-sequence.lsp +@@ -0,0 +1,300 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Jan 19 06:55:04 2004 ++;;;; Contains: Tests of READ-SEQUENCE ++ ++(in-package :cl-test) ++ ++;;; Read into a string ++ ++(defmacro def-read-sequence-test (name init args input &rest expected) ++ `(deftest ,name ++ (let ((s ,init)) ++ (with-input-from-string ++ (is ,input) ++ (values ++ (read-sequence s is ,@args) ++ s))) ++ ,@expected)) ++ ++(def-read-sequence-test read-sequence.string.1 (copy-seq " ") ++ () "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.2 (copy-seq " ") ++ () "abc" 3 "abc ") ++ ++(def-read-sequence-test read-sequence.string.3 (copy-seq " ") ++ (:start 1) "abcdefghijk" 5 " abcd") ++ ++(def-read-sequence-test read-sequence.string.4 (copy-seq " ") ++ (:end 3) "abcdefghijk" 3 "abc ") ++ ++(def-read-sequence-test read-sequence.string.5 (copy-seq " ") ++ (:start 1 :end 4) "abcdefghijk" 4 " abc ") ++ ++(def-read-sequence-test read-sequence.string.6 (copy-seq " ") ++ (:start 0 :end 0) "abcdefghijk" 0 " ") ++ ++(def-read-sequence-test read-sequence.string.7 (copy-seq " ") ++ (:end nil) "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.8 (copy-seq " ") ++ (:allow-other-keys nil) "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.9 (copy-seq " ") ++ (:allow-other-keys t :foo 'bar) "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.10 (copy-seq " ") ++ (:foo 'bar :allow-other-keys 'x) "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.11 (copy-seq " ") ++ (:foo 'bar :allow-other-keys 'x :allow-other-keys nil) ++ "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.string.12 (copy-seq " ") ++ (:end 5 :end 3 :start 0 :start 1) "abcdefghijk" 5 "abcde") ++ ++;;; Read into a base string ++ ++(def-read-sequence-test read-sequence.base-string.1 ++ (make-array 5 :element-type 'base-char) ++ () "abcdefghijk" 5 "abcde") ++ ++(def-read-sequence-test read-sequence.base-string.2 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ () "abc" 3 "abc ") ++ ++(def-read-sequence-test read-sequence.base-string.3 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ (:start 1) "abcdefghijk" 5 " abcd") ++ ++(def-read-sequence-test read-sequence.base-string.4 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ (:end 3) "abcdefghijk" 3 "abc ") ++ ++(def-read-sequence-test read-sequence.base-string.5 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ (:start 1 :end 4) "abcdefghijk" 4 " abc ") ++ ++(def-read-sequence-test read-sequence.base-string.6 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ (:start 0 :end 0) "abcdefghijk" 0 " ") ++ ++(def-read-sequence-test read-sequence.base-string.7 ++ (make-array 5 :element-type 'base-char :initial-element #\Space) ++ (:end nil) "abcdefghijk" 5 "abcde") ++ ++;;; Read into a list ++ ++(def-read-sequence-test read-sequence.list.1 (make-list 5) ++ () "abcdefghijk" 5 (#\a #\b #\c #\d #\e)) ++ ++(def-read-sequence-test read-sequence.list.2 (make-list 5) ++ () "abc" 3 (#\a #\b #\c nil nil)) ++ ++(def-read-sequence-test read-sequence.list.3 (make-list 5) ++ (:start 1) "abcdefghijk" 5 (nil #\a #\b #\c #\d)) ++ ++(def-read-sequence-test read-sequence.list.4 (make-list 5) ++ (:end 3) "abcdefghijk" 3 (#\a #\b #\c nil nil)) ++ ++(def-read-sequence-test read-sequence.list.5 (make-list 5) ++ (:end 4 :start 1) "abcdefghijk" 4 (nil #\a #\b #\c nil)) ++ ++(def-read-sequence-test read-sequence.list.6 (make-list 5) ++ (:start 0 :end 0) "abcdefghijk" 0 (nil nil nil nil nil)) ++ ++(def-read-sequence-test read-sequence.list.7 (make-list 5) ++ (:end nil) "abcdefghijk" 5 (#\a #\b #\c #\d #\e)) ++ ++;;; Read into a vector ++ ++(def-read-sequence-test read-sequence.vector.1 ++ (vector nil nil nil nil nil) ++ () "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) ++ ++(def-read-sequence-test read-sequence.vector.2 ++ (vector nil nil nil nil nil) ++ () "abc" 3 #(#\a #\b #\c nil nil)) ++ ++(def-read-sequence-test read-sequence.vector.3 ++ (vector nil nil nil nil nil) ++ (:start 2) "abcdefghijk" 5 #(nil nil #\a #\b #\c)) ++ ++(def-read-sequence-test read-sequence.vector.4 ++ (vector nil nil nil nil nil) ++ (:start 1 :end 4) "abcdefghijk" 4 #(nil #\a #\b #\c nil)) ++ ++(def-read-sequence-test read-sequence.vector.5 ++ (vector nil nil nil nil nil) ++ (:end 2) "abcdefghijk" 2 #(#\a #\b nil nil nil)) ++ ++(def-read-sequence-test read-sequence.vector.6 ++ (vector nil nil nil nil nil) ++ (:end 0 :start 0) "abcdefghijk" 0 #(nil nil nil nil nil)) ++ ++(def-read-sequence-test read-sequence.vector.7 ++ (vector nil nil nil nil nil) ++ (:end nil) "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) ++ ++;;; Read into a vector with a fill pointer ++ ++(def-read-sequence-test read-sequence.fill-vector.1 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ () "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) ++ ++(def-read-sequence-test read-sequence.fill-vector.2 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ () "ab" 2 #(#\a #\b nil nil nil)) ++ ++(def-read-sequence-test read-sequence.fill-vector.3 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ () "" 0 #(nil nil nil nil nil)) ++ ++(def-read-sequence-test read-sequence.fill-vector.4 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ (:start 2) "abcdefghijk" 5 #(nil nil #\a #\b #\c)) ++ ++(def-read-sequence-test read-sequence.fill-vector.5 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ (:start 1 :end 4) "abcdefghijk" 4 #(nil #\a #\b #\c nil)) ++ ++(def-read-sequence-test read-sequence.fill-vector.6 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ (:end 2) "abcdefghijk" 2 #(#\a #\b nil nil nil)) ++ ++(def-read-sequence-test read-sequence.fill-vector.7 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ (:end 0 :start 0) "abcdefghijk" 0 #(nil nil nil nil nil)) ++ ++(def-read-sequence-test read-sequence.fill-vector.8 ++ (make-array 10 :initial-element nil :fill-pointer 5) ++ (:end nil) "abcdefghijk" 5 #(#\a #\b #\c #\d #\e)) ++ ++;;; Nil vectors ++ ++(deftest read-sequence.nil-vector.1 ++ :notes (:nil-vectors-are-strings) ++ (let ((s (make-array 0 :element-type nil))) ++ (with-input-from-string ++ (is "abcde") ++ (values ++ (read-sequence s is) ++ s))) ++ 0 "") ++ ++;;; Read into a bit vector ++ ++(defmacro def-read-sequence-bv-test (name init args &rest expected) ++ `(deftest ,name ++ ;; Create output file ++ (progn ++ (let (os) ++ (unwind-protect ++ (progn ++ (setq os (open "temp.dat" :direction :output ++ :element-type '(unsigned-byte 8) ++ :if-exists :supersede)) ++ (loop for i in '(0 1 1 0 0 1 1 0 1 0 1 1 1 0) ++ do (write-byte i os))) ++ (when os (close os)))) ++ (let (is (bv (copy-seq ,init))) ++ (unwind-protect ++ (progn ++ (setq is (open "temp.dat" :direction :input ++ :element-type '(unsigned-byte 8))) ++ (values ++ (read-sequence bv is ,@args) ++ bv)) ++ (when is (close is))))) ++ ,@expected)) ++ ++(def-read-sequence-bv-test read-sequence.bv.1 #*00000000000000 () ++ 14 #*01100110101110) ++ ++(def-read-sequence-bv-test read-sequence.bv.2 #*00000000000000 (:start 0) ++ 14 #*01100110101110) ++ ++(def-read-sequence-bv-test read-sequence.bv.3 #*00000000000000 (:end 14) ++ 14 #*01100110101110) ++ ++(def-read-sequence-bv-test read-sequence.bv.4 #*00000000000000 (:end nil) ++ 14 #*01100110101110) ++ ++(def-read-sequence-bv-test read-sequence.bv.5 #*00000000000000 (:start 2) ++ 14 #*00011001101011) ++ ++(def-read-sequence-bv-test read-sequence.bv.6 #*00000000000000 ++ (:start 2 :end 13) ++ 13 #*00011001101010) ++ ++(def-read-sequence-bv-test read-sequence.bv.7 #*00000000000000 (:end 6) ++ 6 #*01100100000000) ++ ++;;; Error cases ++ ++(deftest read-sequence.error.1 ++ (signals-error (read-sequence) program-error) ++ t) ++ ++(deftest read-sequence.error.2 ++ (signals-error (read-sequence (make-string 10)) program-error) ++ t) ++ ++(deftest read-sequence.error.3 ++ (signals-error ++ (read-sequence (make-string 5) (make-string-input-stream "abc") :start) ++ program-error) ++ t) ++ ++(deftest read-sequence.error.4 ++ (signals-error ++ (read-sequence (make-string 5) (make-string-input-stream "abc") :foo 1) ++ program-error) ++ t) ++ ++(deftest read-sequence.error.5 ++ (signals-error ++ (read-sequence (make-string 5) (make-string-input-stream "abc") ++ :allow-other-keys nil :bar 2) ++ program-error) ++ t) ++ ++(deftest read-sequence.error.6 ++ (check-type-error #'(lambda (x) (read-sequence x (make-string-input-stream "abc"))) ++ #'sequencep) ++ nil) ++ ++(deftest read-sequence.error.7 ++ (signals-error ++ (read-sequence (cons 'a 'b) (make-string-input-stream "abc")) ++ type-error) ++ t) ++ ++;;; This test appears to cause Allegro CL to crash ++(deftest read-sequence.error.8 ++ (signals-type-error x -1 ++ (read-sequence (make-string 3) ++ (make-string-input-stream "abc") ++ :start x)) ++ t) ++ ++(deftest read-sequence.error.9 ++ (check-type-error #'(lambda (s) ++ (read-sequence (make-string 3) (make-string-input-stream "abc") ++ :start s)) ++ (typef 'unsigned-byte)) ++ nil) ++ ++(deftest read-sequence.error.10 ++ (signals-type-error x -1 ++ (read-sequence (make-string 3) (make-string-input-stream "abc") ++ :end x)) ++ t) ++ ++(deftest read-sequence.error.11 ++ (check-type-error #'(lambda (e) ++ (read-sequence (make-string 3) (make-string-input-stream "abc") ++ :end e)) ++ (typef '(or unsigned-byte null))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/rename-file.lsp +@@ -0,0 +1,199 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 8 06:22:53 2004 ++;;;; Contains: Tests for RENAME-FILE ++ ++(in-package :cl-test) ++ ++(deftest rename-file.1 ++ (let ((pn1 #p"file-to-be-renamed.txt") ++ (pn2 #p"file-that-was-renamed.txt")) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (values ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename)))))) ++ t nil t (t t t nil nil) t nil t) ++ ++(deftest rename-file.2 ++ (let ((pn1 "file-to-be-renamed.txt") ++ (pn2 "file-that-was-renamed.txt")) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (values ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename)))))) ++ t nil t (t t t nil nil) t nil t) ++ ++ (deftest rename-file.3 ++ (let* ((pn1 (make-pathname :name "file-to-be-renamed" ++ :type "txt" ++ :version :newest ++ :defaults *default-pathname-defaults*)) ++ (pn2 (make-pathname :name "file-that-was-renamed")) ++ (pn3 (make-pathname :name "file-that-was-renamed" ++ :defaults pn1))) ++ (delete-all-versions pn1) ++ (delete-all-versions pn3) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (values ++ (equalpt (pathname-type pn1) ++ (pathname-type defaulted-new-name)) ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn3)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename)))))) ++ t t nil t (t t t nil nil) t nil t) ++ ++(deftest rename-file.4 ++ (let ((pn1 "file-to-be-renamed.txt") ++ (pn2 "file-that-was-renamed.txt")) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (let ((s (open pn1 :direction :output))) ++ (format s "Whatever~%") ++ (close s) ++ (let ((results (multiple-value-list (rename-file s pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (values ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename))))))) ++ t nil t (t t t nil nil) t nil t) ++ ++(deftest rename-file.5 ++ (let ((pn1 "CLTEST:FILE-TO-BE-RENAMED.TXT") ++ (pn2 "CLTEST:FILE-THAT-WAS-RENAMED.TXT")) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (assert (typep (pathname pn1) 'logical-pathname)) ++ (assert (typep (pathname pn2) 'logical-pathname)) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (values ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename)) ++ (notnot (typep defaulted-new-name 'logical-pathname)) ++ )))) ++ t nil t (t t t nil nil) t nil t t) ++ ++;;; Specialized string tests ++ ++(deftest rename-file.6 ++ (do-special-strings ++ (s "file-to-be-renamed.txt" nil) ++ (let ((pn1 s) ++ (pn2 "file-that-was-renamed.txt")) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (assert ++ (equal ++ (list ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename))) ++ '(t nil t (t t t nil nil) t nil t))))))) ++ nil) ++ ++(deftest rename-file.7 ++ (do-special-strings ++ (s "file-that-was-renamed.txt" nil) ++ (let ((pn1 "file-to-be-renamed.txt") ++ (pn2 s)) ++ (delete-all-versions pn1) ++ (delete-all-versions pn2) ++ (with-open-file (s pn1 :direction :output) (format s "Whatever~%")) ++ (let ((results (multiple-value-list (rename-file pn1 pn2)))) ++ (destructuring-bind (defaulted-new-name old-truename new-truename) ++ results ++ (assert ++ (equal ++ (list ++ (=t (length results) 3) ++ (probe-file pn1) ++ (notnot (probe-file pn2)) ++ (list (notnot (pathnamep defaulted-new-name)) ++ (notnot (pathnamep old-truename)) ++ (notnot (pathnamep new-truename)) ++ (typep old-truename 'logical-pathname) ++ (typep new-truename 'logical-pathname)) ++ (notnot (probe-file defaulted-new-name)) ++ (probe-file old-truename) ++ (notnot (probe-file new-truename))) ++ '(t nil t (t t t nil nil) t nil t))))))) ++ nil) ++ ++;;; Error tests ++ ++(deftest rename-file.error.1 ++ (signals-error (rename-file) program-error) ++ t) ++ +--- gcl-2.6.12.orig/ansi-tests/rt.lsp ++++ gcl-2.6.12/ansi-tests/rt.lsp +@@ -21,81 +21,147 @@ + | SOFTWARE. | + |----------------------------------------------------------------------------|# + +-;This is the December 19, 1990 version of the regression tester. ++;This was the December 19, 1990 version of the regression tester, but ++;has since been modified. + + (in-package :regression-test) + ++(declaim (ftype (function (t) t) get-entry expanded-eval do-entries)) ++(declaim (type list *entries*)) ++(declaim (ftype (function (t &rest t) t) report-error)) ++(declaim (ftype (function (t &optional t) t) do-entry)) ++ + (defvar *test* nil "Current test name") + (defvar *do-tests-when-defined* nil) +-(defvar *entries* '(nil) "Test database") ++(defvar *entries* (list nil) "Test database. Has a leading dummy cell that does not contain an entry.") ++(defvar *entries-tail* *entries* "Tail of the *entries* list") ++(defvar *entries-table* (make-hash-table :test #'equal) ++ "Map the names of entries to the cons cell in *entries* that precedes the one whose car is the entry.") + (defvar *in-test* nil "Used by TEST") + (defvar *debug* nil "For debugging") + (defvar *catch-errors* t "When true, causes errors in a test to be caught.") + (defvar *print-circle-on-failure* nil + "Failure reports are printed with *PRINT-CIRCLE* bound to this value.") + +-(defvar *compile-tests* nil "When true, compile the tests before running +-them.") ++(defvar *compile-tests* nil "When true, compile the tests before running them.") ++(defvar *expanded-eval* nil "When true, convert the tests into a form that is less likely to have compiler optimizations.") + (defvar *optimization-settings* '((safety 3))) + ++(defvar *failed-tests* nil "After DO-TESTS, becomes the list of names of tests that have failed") ++(defvar *passed-tests* nil "After DO-TESTS, becomes the list of names of tests that have passed") ++ + (defvar *expected-failures* nil + "A list of test names that are expected to fail.") + +-(defstruct (entry (:conc-name nil) +- (:type list)) +- pend name form) +- +-(defmacro vals (entry) `(cdddr ,entry)) +- +-(defmacro defn (entry) `(cdr ,entry)) ++(defvar *notes* (make-hash-table :test 'equal) ++ "A mapping from names of notes to note objects.") ++ ++(defstruct (entry (:conc-name nil)) ++ pend name props form vals) ++ ++;;; Note objects are used to attach information to tests. ++;;; A typical use is to mark tests that depend on a particular ++;;; part of a set of requirements, or a particular interpretation ++;;; of the requirements. ++ ++(defstruct note ++ name ++ contents ++ disabled ;; When true, tests with this note are considered inactive ++ ) ++ ++;; (defmacro vals (entry) `(cdddr ,entry)) ++ ++(defmacro defn (entry) ++ (let ((var (gensym))) ++ `(let ((,var ,entry)) ++ (list* (name ,var) (form ,var) (vals ,var))))) ++ ++(defun entry-notes (entry) ++ (let* ((props (props entry)) ++ (notes (getf props :notes))) ++ (if (listp notes) ++ notes ++ (list notes)))) ++ ++(defun has-disabled-note (entry) ++ (let ((notes (entry-notes entry))) ++ (loop for n in notes ++ for note = (if (note-p n) n ++ (gethash n *notes*)) ++ thereis (and note (note-disabled note))))) ++ ++(defun has-note (entry note) ++ (unless (note-p note) ++ (let ((new-note (gethash note *notes*))) ++ (setf note new-note))) ++ (and note (not (not (member note (entry-notes entry)))))) + + (defun pending-tests () +- (do ((l (cdr *entries*) (cdr l)) +- (r nil)) +- ((null l) (nreverse r)) +- (when (pend (car l)) +- (push (name (car l)) r)))) ++ (loop for entry in (cdr *entries*) ++ when (and (pend entry) (not (has-disabled-note entry))) ++ collect (name entry))) + + (defun rem-all-tests () + (setq *entries* (list nil)) ++ (setq *entries-tail* *entries*) ++ (clrhash *entries-table*) + nil) + + (defun rem-test (&optional (name *test*)) +- (do ((l *entries* (cdr l))) +- ((null (cdr l)) nil) +- (when (equal (name (cadr l)) name) +- (setf (cdr l) (cddr l)) +- (return name)))) ++ (let ((pred (gethash name *entries-table*))) ++ (when pred ++ (if (null (cddr pred)) ++ (setq *entries-tail* pred) ++ (setf (gethash (name (caddr pred)) *entries-table*) pred)) ++ (setf (cdr pred) (cddr pred)) ++ (remhash name *entries-table*) ++ name))) + + (defun get-test (&optional (name *test*)) + (defn (get-entry name))) + + (defun get-entry (name) +- (let ((entry (find name (cdr *entries*) +- :key #'name +- :test #'equal))) ++ (let ((entry ;; (find name (the list (cdr *entries*)) ++ ;; :key #'name :test #'equal) ++ (cadr (gethash name *entries-table*)) ++ )) + (when (null entry) + (report-error t + "~%No test with name ~:@(~S~)." + name)) + entry)) + +-(defmacro deftest (name form &rest values) +- `(add-entry '(t ,name ,form .,values))) ++(defmacro deftest (name &rest body) ++ (let* ((p body) ++ (properties ++ (loop while (keywordp (first p)) ++ unless (cadr p) ++ do (error "Poorly formed deftest: ~A~%" ++ (list* 'deftest name body)) ++ append (list (pop p) (pop p)))) ++ (form (pop p)) ++ (vals p)) ++ `(add-entry (make-entry :pend t ++ :name ',name ++ :props ',properties ++ :form ',form ++ :vals ',vals)))) + + (defun add-entry (entry) +- (setq entry (copy-list entry)) +- (do ((l *entries* (cdr l))) (nil) +- (when (null (cdr l)) +- (setf (cdr l) (list entry)) +- (return nil)) +- (when (equal (name (cadr l)) +- (name entry)) +- (setf (cadr l) entry) ++ (setq entry (copy-entry entry)) ++ (let* ((pred (gethash (name entry) *entries-table*))) ++ (cond ++ (pred ++ (setf (cadr pred) entry) + (report-error nil + "Redefining test ~:@(~S~)" +- (name entry)) +- (return nil))) ++ (name entry))) ++ (t ++ (setf (gethash (name entry) *entries-table*) *entries-tail*) ++ (setf (cdr *entries-tail*) (cons entry nil)) ++ (setf *entries-tail* (cdr *entries-tail*)) ++ ))) + (when *do-tests-when-defined* + (do-entry entry)) + (setq *test* (name entry))) +@@ -105,53 +171,59 @@ them.") + (apply #'format t args) + (if error? (throw '*debug* nil))) + (error? (apply #'error args)) +- (t (apply #'warn args)))) ++ (t (apply #'warn args))) ++ nil) + +-(defun do-test (&optional (name *test*)) +- (do-entry (get-entry name))) ++(defun do-test (&optional (name *test*) &rest key-args) ++ (flet ((%parse-key-args ++ (&key ++ ((:catch-errors *catch-errors*) *catch-errors*) ++ ((:compile *compile-tests*) *compile-tests*)) ++ (do-entry (get-entry name)))) ++ (apply #'%parse-key-args key-args))) ++ ++(defun my-aref (a &rest args) ++ (apply #'aref a args)) ++ ++(defun my-row-major-aref (a index) ++ (row-major-aref a index)) + + (defun equalp-with-case (x y) + "Like EQUALP, but doesn't do case conversion of characters. + Currently doesn't work on arrays of dimension > 2." + (cond ++ ((eq x y) t) + ((consp x) + (and (consp y) + (equalp-with-case (car x) (car y)) + (equalp-with-case (cdr x) (cdr y)))) + ((and (typep x 'array) + (= (array-rank x) 0)) +- (equalp-with-case (aref x) (aref y))) ++ (equalp-with-case (my-aref x) (my-aref y))) + ((typep x 'vector) + (and (typep y 'vector) + (let ((x-len (length x)) + (y-len (length y))) + (and (eql x-len y-len) + (loop +- for e1 across x +- for e2 across y ++ for i from 0 below x-len ++ for e1 = (my-aref x i) ++ for e2 = (my-aref y i) + always (equalp-with-case e1 e2)))))) + ((and (typep x 'array) + (typep y 'array) + (not (equal (array-dimensions x) + (array-dimensions y)))) + nil) +- #| +- ((and (typep x 'array) +- (= (array-rank x) 2)) +- (let ((dim (array-dimensions x))) +- (loop for i from 0 below (first dim) +- always (loop for j from 0 below (second dim) +- always (equalp-with-case (aref x i j) +- (aref y i j)))))) +- |# + + ((typep x 'array) + (and (typep y 'array) + (let ((size (array-total-size x))) + (loop for i from 0 below size +- always (equalp-with-case (row-major-aref x i) +- (row-major-aref y i)))))) +- ++ always (equalp-with-case (my-row-major-aref x i) ++ (my-row-major-aref y i)))))) ++ ((typep x 'pathname) ++ (equal x y)) + (t (eql x y)))) + + (defun do-entry (entry &optional +@@ -165,49 +237,110 @@ them.") + r) + ;; (declare (special *break-on-warnings*)) + +- (flet ((%do +- () +- (setf r +- (multiple-value-list +- (if *compile-tests* +- (funcall (compile +- nil +- `(lambda () +- (declare +- (optimize ,@*optimization-settings*)) +- ,(form entry)))) +- (eval (form entry))))))) +- (block aborted +- (if *catch-errors* +- (handler-bind (#-ecl (style-warning #'muffle-warning) +- (error #'(lambda (c) +- (setf aborted t) +- (setf r (list c)) +- (return-from aborted nil)))) +- (%do)) +- (%do)))) +- ++ (block aborted ++ (setf r ++ (flet ((%do () ++ (handler-bind ++ #-sbcl nil ++ #+sbcl ((sb-ext:code-deletion-note #'(lambda (c) ++ (if (has-note entry :do-not-muffle) ++ nil ++ (muffle-warning c))))) ++ (cond ++ (*compile-tests* ++ (multiple-value-list ++ (funcall (compile ++ nil ++ `(lambda () ++ (declare ++ (optimize ,@*optimization-settings*)) ++ ,(form entry)))))) ++ (*expanded-eval* ++ (multiple-value-list ++ (expanded-eval (form entry)))) ++ (t ++ (multiple-value-list ++ (eval (form entry)))))))) ++ (if *catch-errors* ++ (handler-bind ++ (#-ecl (style-warning #'(lambda (c) (if (has-note entry :do-not-muffle-warnings) ++ c ++ (muffle-warning c)))) ++ (error #'(lambda (c) ++ (setf aborted t) ++ (setf r (list c)) ++ (return-from aborted nil)))) ++ (%do)) ++ (%do))))) ++ + (setf (pend entry) + (or aborted + (not (equalp-with-case r (vals entry))))) ++ + (when (pend entry) + (let ((*print-circle* *print-circle-on-failure*)) +- (format s "~&Test ~:@(~S~) failed~%Form: ~S~%Expected value~P:~%" +- *test* (form entry) (length (vals entry))) +- (dolist (v (vals entry)) (format s "~10t~S~%" v)) +- (format s "Actual value~P:~%" (length r)) +- (dolist (v r) +- (format s "~10t~S~:[~; [~2:*~A]~]~%" +- v (typep v 'condition))))))) ++ (format s "~&Test ~:@(~S~) failed~ ++ ~%Form: ~S~ ++ ~%Expected value~P: ~ ++ ~{~S~^~%~17t~}~%" ++ *test* (form entry) ++ (length (vals entry)) ++ (vals entry)) ++ (handler-case ++ (let ((st (format nil "Actual value~P: ~ ++ ~{~S~^~%~15t~}.~%" ++ (length r) r))) ++ (format s "~A" st)) ++ (error () (format s "Actual value: #~%"))) ++ (finish-output s))))) + (when (not (pend entry)) *test*)) + ++(defun expanded-eval (form) ++ "Split off top level of a form and eval separately. This reduces the chance that ++ compiler optimizations will fold away runtime computation." ++ (if (not (consp form)) ++ (eval form) ++ (let ((op (car form))) ++ (cond ++ ((eq op 'let) ++ (let* ((bindings (loop for b in (cadr form) ++ collect (if (consp b) b (list b nil)))) ++ (vars (mapcar #'car bindings)) ++ (binding-forms (mapcar #'cadr bindings))) ++ (apply ++ (the function ++ (eval `(lambda ,vars ,@(cddr form)))) ++ (mapcar #'eval binding-forms)))) ++ ((and (eq op 'let*) (cadr form)) ++ (let* ((bindings (loop for b in (cadr form) ++ collect (if (consp b) b (list b nil)))) ++ (vars (mapcar #'car bindings)) ++ (binding-forms (mapcar #'cadr bindings))) ++ (funcall ++ (the function ++ (eval `(lambda (,(car vars) &aux ,@(cdr bindings)) ,@(cddr form)))) ++ (eval (car binding-forms))))) ++ ((eq op 'progn) ++ (loop for e on (cdr form) ++ do (if (null (cdr e)) (return (eval (car e))) ++ (eval (car e))))) ++ ((and (symbolp op) (fboundp op) ++ (not (macro-function op)) ++ (not (special-operator-p op))) ++ (apply (symbol-function op) ++ (mapcar #'eval (cdr form)))) ++ (t (eval form)))))) ++ + (defun continue-testing () + (if *in-test* + (throw '*in-test* nil) + (do-entries *standard-output*))) + +-(defun do-tests (&optional +- (out *standard-output*)) ++(defun do-tests (&key (out *standard-output*) ++ ((:catch-errors *catch-errors*) *catch-errors*) ++ ((:compile *compile-tests*) *compile-tests*)) ++ (setq *failed-tests* nil ++ *passed-tests* nil) + (dolist (entry (cdr *entries*)) + (setf (pend entry) t)) + (if (streamp out) +@@ -219,13 +352,19 @@ them.") + (defun do-entries (s) + (format s "~&Doing ~A pending test~:P ~ + of ~A tests total.~%" +- (count t (cdr *entries*) +- :key #'pend) ++ (count t (the list (cdr *entries*)) :key #'pend) + (length (cdr *entries*))) ++ (finish-output s) + (dolist (entry (cdr *entries*)) +- (when (pend entry) +- (format s "~@[~<~%~:; ~:@(~S~)~>~]" +- (do-entry entry s)))) ++ (when (and (pend entry) ++ (not (has-disabled-note entry))) ++ (let ((success? (do-entry entry s))) ++ (if success? ++ (push (name entry) *passed-tests*) ++ (push (name entry) *failed-tests*)) ++ (format s "~@[~<~%~:; ~:@(~S~)~>~]" success?)) ++ (finish-output s) ++ )) + (let ((pending (pending-tests)) + (expected-table (make-hash-table :test #'equal))) + (dolist (ex *expected-failures*) +@@ -252,19 +391,46 @@ them.") + ~^, ~}~)." + (length new-failures) + new-failures))) +- (when *expected-failures* +- (let ((pending-table (make-hash-table :test #'equal))) +- (dolist (ex pending) +- (setf (gethash ex pending-table) t)) +- (let ((unexpected-successes +- (loop :for ex :in *expected-failures* +- :unless (gethash ex pending-table) :collect ex))) +- (if unexpected-successes +- (format t "~&~:D unexpected successes: ~ +- ~:@(~{~<~% ~1:;~S~>~ +- ~^, ~}~)." +- (length unexpected-successes) +- unexpected-successes) +- (format t "~&No unexpected successes."))))) + )) ++ (finish-output s) + (null pending)))) ++ ++;;; Note handling functions and macros ++ ++(defmacro defnote (name contents &optional disabled) ++ `(eval-when (:load-toplevel :execute) ++ (let ((note (make-note :name ',name ++ :contents ',contents ++ :disabled ',disabled))) ++ (setf (gethash (note-name note) *notes*) note) ++ note))) ++ ++(defun disable-note (n) ++ (let ((note (if (note-p n) n ++ (setf n (gethash n *notes*))))) ++ (unless note (error "~A is not a note or note name." n)) ++ (setf (note-disabled note) t) ++ note)) ++ ++(defun enable-note (n) ++ (let ((note (if (note-p n) n ++ (setf n (gethash n *notes*))))) ++ (unless note (error "~A is not a note or note name." n)) ++ (setf (note-disabled note) nil) ++ note)) ++ ++;;; Extended random regression ++ ++(defun do-extended-tests (&key (tests *passed-tests*) (count nil) ++ ((:catch-errors *catch-errors*) *catch-errors*) ++ ((:compile *compile-tests*) *compile-tests*)) ++ "Execute randomly chosen tests from TESTS until one fails or until ++ COUNT is an integer and that many tests have been executed." ++ (let ((test-vector (coerce tests 'simple-vector))) ++ (let ((n (length test-vector))) ++ (when (= n 0) (error "Must provide at least one test.")) ++ (loop for i from 0 ++ for name = (svref test-vector (random n)) ++ until (eql i count) ++ do (print name) ++ unless (do-test name) return (values name (1+ i)))))) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/stream-element-type.lsp +@@ -0,0 +1,102 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 13 20:09:50 2004 ++;;;; Contains: Tests for STREAM-ELEMENT-TYPE ++ ++(in-package :cl-test) ++ ++(deftest stream-element-type.1 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-input* *standard-output* ++ *trace-output* *terminal-io*) ++ for results = (multiple-value-list (stream-element-type s)) ++ unless (and (eql (length results) 1) ++ (car results)) ++ collect s) ++ nil) ++ ++(deftest stream-element-type.2 ++ (let ((pn "foo.txt")) ++ (loop for i from 1 to 100 ++ for etype = `(unsigned-byte ,i) ++ for s = (progn (delete-all-versions pn) ++ (open pn :direction :output ++ :element-type etype)) ++ unless ++ (multiple-value-bind (sub good) ++ (subtypep etype (stream-element-type s)) ++ (close s) ++ (or sub (not good))) ++ collect i)) ++ nil) ++ ++(deftest stream-element-type.3 ++ (let ((pn "foo.txt")) ++ (loop for i from 1 to 100 ++ for etype = `(signed-byte ,i) ++ for s = (progn (delete-all-versions pn) ++ (open pn :direction :output ++ :element-type etype)) ++ unless ++ (multiple-value-bind (sub good) ++ (subtypep etype (stream-element-type s)) ++ (close s) ++ (or sub (not good))) ++ collect i)) ++ nil) ++ ++(deftest stream-element-type.4 ++ (let ((pn "foo.txt")) ++ (loop for i from 1 to 100 ++ for etype = `(integer 0 ,i) ++ for s = (progn (delete-all-versions pn) ++ (open pn :direction :output ++ :element-type etype)) ++ unless ++ (multiple-value-bind (sub good) ++ (subtypep etype (stream-element-type s)) ++ (close s) ++ (or sub (not good))) ++ collect i)) ++ nil) ++ ++ ++(deftest stream-element-type.5 ++ :notes (:assume-no-simple-streams) ++ (let ((pn "foo.txt")) ++ (delete-all-versions pn) ++ (let ((s (open pn :direction :output))) ++ (let ((etype (stream-element-type s))) ++ (unwind-protect ++ (equalt (multiple-value-list (subtypep* 'character etype)) ++ '(nil t)) ++ (close s))))) ++ nil) ++ ++(deftest stream-element-type.6 ++ :notes (:assume-no-simple-streams) ++ (let ((pn "foo.txt")) ++ (delete-all-versions pn) ++ (let ((s (open pn :direction :output ++ :element-type :default))) ++ (let ((etype (stream-element-type s))) ++ (unwind-protect ++ (multiple-value-bind (sub1 good1) (subtypep* etype 'integer) ++ (multiple-value-bind (sub2 good2) (subtypep* etype 'character) ++ (or (not good1) ++ (not good2) ++ sub1 sub2))) ++ (close s))))) ++ t) ++ ++(deftest stream-element-type.error.1 ++ (signals-error (stream-element-type) program-error) ++ t) ++ ++(deftest stream-element-type.error.2 ++ (signals-error (stream-element-type *standard-input* nil) program-error) ++ t) ++ ++(deftest stream-element-type.error.3 ++ (check-type-error #'stream-element-type #'streamp) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/stream-error-stream.lsp +@@ -0,0 +1,34 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 20:51:33 2004 ++;;;; Contains: Tests of STREAM-ERROR-STREAM ++ ++(in-package :cl-test) ++ ++(deftest stream-error-stream.1 ++ (with-input-from-string ++ (s "") ++ (handler-case ++ (read-char s) ++ (stream-error (c) (eqlt (stream-error-stream c) s)))) ++ t) ++ ++;;; Error tests ++ ++(deftest stream-error-stream.error.1 ++ (signals-error (stream-error-stream) program-error) ++ t) ++ ++ ++(deftest stream-error-stream.error.2 ++ (signals-error ++ (with-input-from-string ++ (s "") ++ (handler-case ++ (read-char s) ++ (stream-error (c) (stream-error-stream c nil)))) ++ program-error) ++ t) ++ ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/stream-external-format.lsp +@@ -0,0 +1,24 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 27 20:53:21 2004 ++;;;; Contains: Tests of STREAM-EXTERNAL-FORMAT ++ ++(in-package :cl-test) ++ ++;;; This is tested in open.lsp ++ ++;;; Error tests ++ ++(deftest stream-external-format.error.1 ++ (signals-error (stream-external-format) program-error) ++ t) ++ ++(deftest stream-external-format.error.2 ++ (signals-error ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :output :if-exists :supersede) ++ (stream-external-format s nil))) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/streamp.lsp +@@ -0,0 +1,44 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Jan 17 17:12:38 2004 ++;;;; Contains: Tests for STREAMP ++ ++(in-package :cl-test) ++ ++(deftest streamp.1 ++ (loop for s in (list *debug-io* *error-output* *query-io* ++ *standard-input* *standard-output* ++ *trace-output* *terminal-io*) ++ unless (equal (multiple-value-list (notnot-mv (streamp s))) ++ '(t)) ++ collect s) ++ nil) ++ ++(deftest streamp.2 ++ (check-type-predicate #'streamp 'stream) ++ 0) ++ ++(deftest streamp.3 ++ (let ((s (open "foo.txt" :direction :output ++ :if-exists :supersede))) ++ (close s) ++ (notnot-mv (streamp s))) ++ t) ++ ++(deftest streamp.4 ++ (let ((s (open "foo.txt" :direction :output ++ :if-exists :supersede))) ++ (unwind-protect ++ (notnot-mv (streamp s)) ++ (close s))) ++ t) ++ ++;;; Error tests ++ ++(deftest streamp.error.1 ++ (signals-error (streamp) program-error) ++ t) ++ ++(deftest streamp.error.2 ++ (signals-error (streamp *standard-input* nil) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/synonym-stream-symbol.lsp +@@ -0,0 +1,23 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Jan 29 21:21:06 2004 ++;;;; Contains: Tests of SYNONYM-STREAM-SYMBOL ++ ++(in-package :cl-test) ++ ++(deftest synonym-stream-symbol.1 ++ (synonym-stream-symbol (make-synonym-stream '*standard-input*)) ++ *standard-input*) ++ ++(deftest synonym-stream-symbol.error.1 ++ (signals-error (synonym-stream-symbol) program-error) ++ t) ++ ++(deftest synonym-stream-symbol.error.2 ++ (signals-error (synonym-stream-symbol ++ (make-synonym-stream '*terminal-io*) ++ nil) ++ program-error) ++ t) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/terpri.lsp +@@ -0,0 +1,62 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:35:57 2004 ++;;;; Contains: Tests of TERPRI ++ ++(in-package :cl-test) ++ ++(deftest terpri.1 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (write-char #\a) ++ (setq result (terpri))) ++ result)) ++ #.(concatenate 'string "a" (string #\Newline)) ++ nil) ++ ++(deftest terpri.2 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (write-char #\a s) ++ (setq result (terpri s))) ++ result)) ++ #.(concatenate 'string "a" (string #\Newline)) ++ nil) ++ ++(deftest terpri.3 ++ (with-output-to-string ++ (s) ++ (write-char #\x s) ++ (terpri s) ++ (terpri s) ++ (write-char #\y s)) ++ #.(concatenate 'string "x" (string #\Newline) (string #\Newline) "y")) ++ ++(deftest terpri.4 ++ (with-output-to-string ++ (os) ++ (let ((*terminal-io* (make-two-way-stream *standard-input* os))) ++ (terpri t) ++ (finish-output t))) ++ #.(string #\Newline)) ++ ++(deftest terpri.5 ++ (with-output-to-string ++ (*standard-output*) ++ (terpri nil)) ++ #.(string #\Newline)) ++ ++;;; Error tests ++ ++(deftest terpri.error.1 ++ (signals-error ++ (with-output-to-string ++ (s) ++ (terpri s nil)) ++ program-error) ++ t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/translate-logical-pathname.lsp +@@ -0,0 +1,48 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Dec 29 14:45:50 2003 ++;;;; Contains: Tests for TRANSLATE-LOGICAL-PATHNAME ++ ++(in-package :cl-test) ++ ++;; On physical pathnames, t-l-p returns the pathname itself ++ ++;;; Every physical pathname is converted to itself ++(deftest translate-logical-pathname.1 ++ (loop for p in *pathnames* ++ unless (or (typep p 'logical-pathname) ++ (eq p (translate-logical-pathname p))) ++ collect p) ++ nil) ++ ++;;; &key arguments are allowed ++(deftest translate-logical-pathname.2 ++ (loop for p in *pathnames* ++ unless (or (typep p 'logical-pathname) ++ (eq p (translate-logical-pathname ++ p :allow-other-keys t))) ++ collect p) ++ nil) ++ ++(deftest translate-logical-pathname.3 ++ (loop for p in *pathnames* ++ unless (or (typep p 'logical-pathname) ++ (eq p (translate-logical-pathname ++ p :allow-other-keys nil))) ++ collect p) ++ nil) ++ ++(deftest translate-logical-pathname.4 ++ (loop for p in *pathnames* ++ unless (or (typep p 'logical-pathname) ++ (eq p (translate-logical-pathname ++ p :foo 1 :allow-other-keys t :bar 2))) ++ collect p) ++ nil) ++ ++ ++;;; errors ++ ++(deftest translate-logical-pathname.error.1 ++ (signals-error (translate-logical-pathname) program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/translate-pathname.lsp +@@ -0,0 +1,50 @@ ++;-*- Mode: Lisp -*- ++ ++(in-package :cl-test) ++ ++(deftest translate-pathname.1 (translate-pathname "foobar" "foobar" "foobar") #P"foobar") ++(deftest translate-pathname.2 (translate-pathname "foobar" "foobar" "foo*") #P"foo") ++(deftest translate-pathname.3 (translate-pathname "foobar" "foobar" "*") #P"foobar") ++(deftest translate-pathname.4 (translate-pathname "foobar" "foobar" "") #P"foobar") ++ ++(deftest translate-pathname.5 (translate-pathname "foobar" "foo*r" "foobar") #P"foobar") ++(deftest translate-pathname.6 (translate-pathname "foobar" "foo*r" "foo*") #P"fooba") ++(deftest translate-pathname.7 (translate-pathname "foobar" "foo*r" "*") #P"foobar") ++(deftest translate-pathname.8 (translate-pathname "foobar" "foo*r" "") #P"foobar") ++ ++(deftest translate-pathname.9 (translate-pathname "foobar" "*" "foobar") #P"foobar") ++(deftest translate-pathname.10 (translate-pathname "foobar" "*" "foo*") #P"foofoobar") ++(deftest translate-pathname.11 (translate-pathname "foobar" "*" "*") #P"foobar") ++(deftest translate-pathname.12 (translate-pathname "foobar" "*" "") #P"foobar") ++ ++(deftest translate-pathname.13 (translate-pathname "foobar" "" "foobar") #P"foobar") ++(deftest translate-pathname.14 (translate-pathname "foobar" "" "foo*") #P"foofoobar") ++(deftest translate-pathname.15 (translate-pathname "foobar" "" "*") #P"foobar") ++(deftest translate-pathname.16 (translate-pathname "foobar" "" "") #P"foobar") ++ ++(deftest translate-pathname.17 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") ++(deftest translate-pathname.18 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/q*c*/c/d/") #P"/a/qc/c/d/") ++(deftest translate-pathname.19 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/*/c/d/") #P"/a/c/d/") ++(deftest translate-pathname.20 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "/a/**/d/") #P"/a/d/") ++ ++(deftest translate-pathname.21 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") ++(deftest translate-pathname.22 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/q*c*/c/d/") #P"/a/qbcb/c/d/") ++(deftest translate-pathname.23 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/*/c/d/") #P"/a/bbfb/c/d/") ++(deftest translate-pathname.24 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "/a/**/d/") #P"/a/bbfb/d/") ++ ++(deftest translate-pathname.25 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/qc/c/d/") #P"/a/qc/c/d/") ++(deftest translate-pathname.26 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/q*c*/c/d/") #P"/a/qc/c/d/") ++(deftest translate-pathname.27 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/*/d/") #P"/a/bbfb/d/") ++(deftest translate-pathname.28 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "/a/**/d/") #P"/a/bbfb/c/d/") ++ ++(deftest translate-pathname.29 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/qc/c/d/") #P"a/qc/c/d/") ++(deftest translate-pathname.30 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/q*c*/c/d/") #P"a/qc/c/d/") ++(deftest translate-pathname.31 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/*/d/") #P"a/bbfb/d/") ++(deftest translate-pathname.32 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a/**/d/") #P"a/bbfb/c/d/") ++ ++(deftest translate-pathname.33 (translate-pathname "/a/bbfb/c/d/" "/a/bbfb/c/d/" "a") #P"/a/bbfb/c/d/a") ++(deftest translate-pathname.34 (translate-pathname "/a/bbfb/c/d/" "/a/b*f*/c/d/" "a") #P"/a/bbfb/c/d/a") ++(deftest translate-pathname.35 (translate-pathname "/a/bbfb/c/d/" "/a/*/c/d/" "a") #P"/a/bbfb/c/d/a") ++(deftest translate-pathname.36 (translate-pathname "/a/bbfb/c/d/" "/a/**/d/" "a") #P"/a/bbfb/c/d/a") ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/truename.lsp +@@ -0,0 +1,108 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 6 05:32:37 2004 ++;;;; Contains: Tests of TRUENAME ++ ++(in-package :cl-test) ++ ++(deftest truename.1 ++ (let* ((pn #p"truename.lsp") ++ (tn (truename pn))) ++ (values ++ (notnot (pathnamep pn)) ++ (typep pn 'logical-pathname) ++ (equalt (pathname-name pn) (pathname-name tn)) ++ (equalt (pathname-type pn) (pathname-type tn)) ++ )) ++ t nil t t) ++ ++(deftest truename.2 ++ (let* ((name "truename.lsp") ++ (pn (pathname name)) ++ (tn (truename name))) ++ (values ++ (notnot (pathnamep pn)) ++ (typep pn 'logical-pathname) ++ (equalt (pathname-name pn) (pathname-name tn)) ++ (equalt (pathname-type pn) (pathname-type tn)) ++ )) ++ t nil t t) ++ ++(deftest truename.3 ++ (let* ((pn #p"truename.lsp")) ++ (with-open-file ++ (s pn :direction :input) ++ (let ((tn (truename s))) ++ (values ++ (notnot (pathnamep pn)) ++ (typep pn 'logical-pathname) ++ (equalt (pathname-name pn) (pathname-name tn)) ++ (equalt (pathname-type pn) (pathname-type tn)) ++ )))) ++ t nil t t) ++ ++(deftest truename.4 ++ (let* ((pn #p"truename.lsp")) ++ (let ((s (open pn :direction :input))) ++ (close s) ++ (let ((tn (truename s))) ++ (values ++ (notnot (pathnamep pn)) ++ (typep pn 'logical-pathname) ++ (equalt (pathname-name pn) (pathname-name tn)) ++ (equalt (pathname-type pn) (pathname-type tn)) ++ )))) ++ t nil t t) ++ ++(deftest truename.5 ++ (let* ((lpn "CLTEST:foo.txt") ++ (pn (translate-logical-pathname lpn))) ++ (unless (probe-file lpn) ++ (with-open-file (s lpn :direction :output) (format s "Stuff~%"))) ++ (let ((tn (truename lpn))) ++ (values ++ (notnot (pathnamep pn)) ++ (if (equalt (pathname-name pn) (pathname-name tn)) ++ t (list (pathname-name pn) (pathname-name tn))) ++ (if (equalt (pathname-type pn) (pathname-type tn)) ++ t (list (pathname-type pn) (pathname-type tn))) ++ ))) ++ t t t) ++ ++;;; Specialized string tests ++ ++(deftest truename.6 ++ (do-special-strings ++ (s "truename.lsp" nil) ++ (assert (equalp (truename s) (truename "truename.lsp")))) ++ nil) ++ ++;;; Error tests ++ ++(deftest truename.error.1 ++ (signals-error (truename) program-error) ++ t) ++ ++(deftest truename.error.2 ++ (signals-error (truename "truename.lsp" nil) program-error) ++ t) ++ ++(deftest truename.error.3 ++ (signals-error-always (truename "nonexistent") file-error) ++ t t) ++ ++(deftest truename.error.4 ++ (signals-error-always (truename #p"nonexistent") file-error) ++ t t) ++ ++(deftest truename.error.5 ++ (signals-error-always (truename (logical-pathname "CLTESTROOT:NONEXISTENT")) file-error) ++ t t) ++ ++(deftest truename.error.6 ++ (signals-error-always ++ (let ((pn (make-pathname :name :wild ++ :defaults *default-pathname-defaults*))) ++ (truename pn)) ++ file-error) ++ t t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/two-way-stream-input-stream.lsp +@@ -0,0 +1,26 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Feb 12 04:22:50 2004 ++;;;; Contains: Tests of TWO-WAY-STREAM-INPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest two-way-stream-input-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (equalt (multiple-value-list (two-way-stream-input-stream s)) ++ (list is))) ++ t) ++ ++(deftest two-way-stream-input-stream.error.1 ++ (signals-error (two-way-stream-input-stream) program-error) ++ t) ++ ++(deftest two-way-stream-input-stream.error.2 ++ (signals-error (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (two-way-stream-input-stream s nil)) ++ program-error) ++ t) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/two-way-stream-output-stream.lsp +@@ -0,0 +1,26 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Thu Feb 12 04:25:59 2004 ++;;;; Contains: Tests off TWO-WAY-STREAM-OUTPUT-STREAM ++ ++(in-package :cl-test) ++ ++(deftest two-way-stream-output-stream.1 ++ (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (equalt (multiple-value-list (two-way-stream-output-stream s)) ++ (list os))) ++ t) ++ ++(deftest two-way-stream-output-stream.error.1 ++ (signals-error (two-way-stream-output-stream) program-error) ++ t) ++ ++(deftest two-way-stream-output-stream.error.2 ++ (signals-error (let* ((is (make-string-input-stream "foo")) ++ (os (make-string-output-stream)) ++ (s (make-two-way-stream is os))) ++ (two-way-stream-output-stream s nil)) ++ program-error) ++ t) +--- gcl-2.6.12.orig/ansi-tests/universe.lsp ++++ gcl-2.6.12/ansi-tests/universe.lsp +@@ -307,15 +307,50 @@ + #-(or GCL CMU ECL) (make-hash-table :test #'equalp) + )) + +-(defvar *pathnames* +- (list +- (make-pathname :name "foo") +- (make-pathname :name "bar") +- (make-pathname :name "foo" :type "txt") +- (make-pathname :name "bar" :type "txt") +- (make-pathname :name :wild) +- (make-pathname :name :wild :type "txt") +- )) ++(defparameter *pathnames* ++ (locally ++ (declare (optimize safety)) ++ (loop for form in '((make-pathname :name "foo") ++ (make-pathname :name "FOO" :case :common) ++ (make-pathname :name "bar") ++ (make-pathname :name "foo" :type "txt") ++ (make-pathname :name "bar" :type "txt") ++ (make-pathname :name "XYZ" :type "TXT" :case :common) ++ (make-pathname :name nil) ++ (make-pathname :name :wild) ++ (make-pathname :name nil :type "txt") ++ (make-pathname :name :wild :type "txt") ++ (make-pathname :name :wild :type "TXT" :case :common) ++ (make-pathname :name :wild :type "abc" :case :common) ++ (make-pathname :directory :wild) ++ (make-pathname :type :wild) ++ (make-pathname :version :wild) ++ (make-pathname :version :newest)) ++ append (ignore-errors (eval `(list ,form)))))) ++ ++(eval-when (:compile-toplevel :load-toplevel :execute) ++ (locally ++ (declare (optimize safety)) ++ (ignore-errors ++ (setf (logical-pathname-translations "CLTESTROOT") ++ `(("**;*.*.*" ,(make-pathname :directory '(:absolute :wild-inferiors) ++ :name :wild :type :wild))))) ++ (ignore-errors ++ (setf (logical-pathname-translations "CLTEST") ++ `(("**;*.*.*" ,(make-pathname ++ :directory (append ++ (pathname-directory ++ (truename (make-pathname))) ++ '(:wild-inferiors)) ++ :name :wild :type :wild))))) ++ )) ++ ++(defparameter *logical-pathnames* ++ (locally ++ (declare (optimize safety)) ++ (append ++ (ignore-errors (list (logical-pathname "CLTESTROOT:"))) ++ ))) + + (defvar *streams* + (remove-duplicates +--- /dev/null ++++ gcl-2.6.12/ansi-tests/unread-char.lsp +@@ -0,0 +1,92 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:05:36 2004 ++;;;; Contains: Tests of UNREAD-CHAR ++ ++(in-package :cl-test) ++ ++(deftest unread-char.1 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (values ++ (read-char) ++ (unread-char #\a) ++ (read-char) ++ (read-char) ++ (unread-char #\b) ++ (read-char) ++ (read-char))) ++ #\a nil #\a #\b nil #\b #\c) ++ ++(deftest unread-char.2 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (read-char s) ++ (unread-char #\a s) ++ (read-char s) ++ (read-char s) ++ (unread-char #\b s) ++ (read-char s) ++ (read-char s))) ++ #\a nil #\a #\b nil #\b #\c) ++ ++(deftest unread-char.3 ++ (with-input-from-string ++ (is "abc") ++ (with-output-to-string ++ (os) ++ (let ((s (make-echo-stream is os))) ++ (read-char s) ++ (unread-char #\a s) ++ (read-char s) ++ (read-char s) ++ (read-char s) ++ (unread-char #\c s) ++ (read-char s)))) ++ "abc") ++ ++(deftest unread-char.4 ++ (with-input-from-string ++ (*standard-input* "abc") ++ (values ++ (read-char) ++ (unread-char #\a nil) ++ (read-char) ++ (read-char) ++ (unread-char #\b nil) ++ (read-char) ++ (read-char))) ++ #\a nil #\a #\b nil #\b #\c) ++ ++(deftest unread-char.5 ++ (with-input-from-string ++ (is "abc") ++ (let ((*terminal-io* (make-two-way-stream ++ is (make-string-output-stream)))) ++ (values ++ (read-char t) ++ (unread-char #\a t) ++ (read-char t) ++ (read-char t) ++ (unread-char #\b t) ++ (read-char t) ++ (read-char t)))) ++ #\a nil #\a #\b nil #\b #\c) ++ ++;;; Error tests ++ ++(deftest unread-char.error.1 ++ (signals-error (unread-char) program-error) ++ t) ++ ++(deftest unread-char.error.2 ++ (signals-error ++ (with-input-from-string ++ (s "abc") ++ (read-char s) ++ (unread-char #\a s nil)) ++ program-error) ++ t) ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/wild-pathname-p.lsp +@@ -0,0 +1,234 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Dec 31 16:54:55 2003 ++;;;; Contains: Tests of WILD-PATHNAME-P ++ ++(in-package :cl-test) ++ ++(compile-and-load "pathnames-aux.lsp") ++ ++(deftest wild-pathname-p.1 ++ (wild-pathname-p (make-pathname)) ++ nil) ++ ++(deftest wild-pathname-p.2 ++ (loop for key in '(:host :device :directory :name :type :version nil) ++ when (wild-pathname-p (make-pathname) key) ++ collect key) ++ nil) ++ ++(deftest wild-pathname-p.3 ++ (let ((p (make-pathname :directory :wild))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.4 ++ (let ((p (make-pathname :directory :wild))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.5 ++ (let ((p (make-pathname :directory :wild))) ++ (notnot-mv (wild-pathname-p p :directory))) ++ t) ++ ++(deftest wild-pathname-p.6 ++ (let ((p (make-pathname :directory :wild))) ++ (loop for key in '(:host :device :name :type :version) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++ ++(deftest wild-pathname-p.7 ++ (let ((p (make-pathname :directory '(:absolute :wild)))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.8 ++ (let ((p (make-pathname :directory '(:absolute :wild)))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.9 ++ (let ((p (make-pathname :directory '(:absolute :wild)))) ++ (notnot-mv (wild-pathname-p p :directory))) ++ t) ++ ++(deftest wild-pathname-p.10 ++ (let ((p (make-pathname :directory '(:absolute :wild)))) ++ (loop for key in '(:host :device :name :type :version) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++ ++(deftest wild-pathname-p.11 ++ (let ((p (make-pathname :directory '(:relative :wild)))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.12 ++ (let ((p (make-pathname :directory '(:relative :wild)))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.13 ++ (let ((p (make-pathname :directory '(:relative :wild)))) ++ (notnot-mv (wild-pathname-p p :directory))) ++ t) ++ ++(deftest wild-pathname-p.14 ++ (let ((p (make-pathname :directory '(:relative :wild)))) ++ (loop for key in '(:host :device :name :type :version) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++;;; ++ ++(deftest wild-pathname-p.15 ++ (let ((p (make-pathname :name :wild))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.16 ++ (let ((p (make-pathname :name :wild))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.17 ++ (let ((p (make-pathname :name :wild))) ++ (notnot-mv (wild-pathname-p p :name))) ++ t) ++ ++(deftest wild-pathname-p.18 ++ (let ((p (make-pathname :name :wild))) ++ (loop for key in '(:host :device :directory :type :version) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++;;; ++ ++(deftest wild-pathname-p.19 ++ (let ((p (make-pathname :type :wild))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.20 ++ (let ((p (make-pathname :type :wild))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.21 ++ (let ((p (make-pathname :type :wild))) ++ (notnot-mv (wild-pathname-p p :type))) ++ t) ++ ++(deftest wild-pathname-p.22 ++ (let ((p (make-pathname :type :wild))) ++ (loop for key in '(:host :device :directory :name :version) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++;;; ++ ++ (deftest wild-pathname-p.23 ++ (let ((p (make-pathname :version :wild))) ++ (notnot-mv (wild-pathname-p p))) ++ t) ++ ++(deftest wild-pathname-p.24 ++ (let ((p (make-pathname :version :wild))) ++ (notnot-mv (wild-pathname-p p nil))) ++ t) ++ ++(deftest wild-pathname-p.25 ++ (let ((p (make-pathname :version :wild))) ++ (notnot-mv (wild-pathname-p p :version))) ++ t) ++ ++(deftest wild-pathname-p.26 ++ (let ((p (make-pathname :version :wild))) ++ (loop for key in '(:host :device :directory :name :type) ++ when (wild-pathname-p p key) ++ collect key)) ++ nil) ++ ++;;; ++ ++(deftest wild-pathname-p.27 ++ (loop for p in (append *pathnames* *logical-pathnames*) ++ unless (if (wild-pathname-p p) (wild-pathname-p p nil) ++ (not (wild-pathname-p p nil))) ++ collect p) ++ nil) ++ ++(deftest wild-pathname-p.28 ++ (loop for p in (append *pathnames* *logical-pathnames*) ++ when (and (loop for key in '(:host :device :directory ++ :name :type :version) ++ thereis (wild-pathname-p p key)) ++ (not (wild-pathname-p p))) ++ collect p) ++ nil) ++ ++;;; On streams associated with files ++ ++(deftest wild-pathname-p.29 ++ (with-open-file (s "foo.lsp" ++ :direction :output ++ :if-exists :append ++ :if-does-not-exist :create) ++ (wild-pathname-p s)) ++ nil) ++ ++(deftest wild-pathname-p.30 ++ (let ((s (open "foo.lsp" ++ :direction :output ++ :if-exists :append ++ :if-does-not-exist :create))) ++ (close s) ++ (wild-pathname-p s)) ++ nil) ++ ++;;; logical pathname designators ++ ++(deftest wild-pathname-p.31 ++ (wild-pathname-p "CLTEST:FOO.LISP") ++ nil) ++ ++;;; Odd strings ++ ++(deftest wild-pathname-p.32 ++ (do-special-strings ++ (s "CLTEST:FOO.LISP" nil) ++ (let ((vals (multiple-value-list (wild-pathname-p s)))) ++ (assert (equal vals '(nil))))) ++ nil) ++ ++;;; ++ ++(deftest wild-pathname-p.error.1 ++ (signals-error (wild-pathname-p) program-error) ++ t) ++ ++(deftest wild-pathname-p.error.2 ++ (signals-error (wild-pathname-p *default-pathname-defaults* nil nil) ++ program-error) ++ t) ++ ++(deftest wild-pathname-p.error.3 ++ (check-type-error #'wild-pathname-p ++ (typef '(or pathname string file-stream ++ synonym-stream))) ++ nil) ++ ++(deftest wild-pathname-p.error.4 ++ (check-type-error #'(lambda (x) (declare (optimize (safety 0))) ++ (wild-pathname-p x)) ++ (typef '(or pathname string file-stream ++ synonym-stream))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/with-input-from-string.lsp +@@ -0,0 +1,245 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 20:13:02 2004 ++;;;; Contains: Tests of WITH-INPUT-FROM-STRING ++ ++(in-package :cl-test) ++ ++(deftest with-input-from-string.1 ++ (with-input-from-string ++ (s "abc") ++ (values (read-char s) (read-char s) (read-char s) (read-char s nil :eof))) ++ #\a #\b #\c :eof) ++ ++(deftest with-input-from-string.2 ++ (with-input-from-string (s "abc")) ++ nil) ++ ++(deftest with-input-from-string.3 ++ (with-input-from-string (s "abc") (declare (optimize speed))) ++ nil) ++ ++(deftest with-input-from-string.3a ++ (with-input-from-string (s "abc") ++ (declare (optimize speed)) ++ (declare (optimize space))) ++ nil) ++ ++(deftest with-input-from-string.4 ++ (with-input-from-string ++ (s "abc") ++ (declare (optimize safety)) ++ (read-char s) ++ (read-char s)) ++ #\b) ++ ++(deftest with-input-from-string.5 ++ (let ((i nil)) ++ (values ++ (with-input-from-string ++ (s "abc" :index i)) ++ i)) ++ nil 0) ++ ++(deftest with-input-from-string.6 ++ (let ((i (list nil))) ++ (values ++ (with-input-from-string ++ (s "abc" :index (car i))) ++ i)) ++ nil (0)) ++ ++(deftest with-input-from-string.7 ++ (let ((i nil)) ++ (values ++ (with-input-from-string ++ (s "abc" :index i) ++ (list i (read-char s) i (read-char s) i)) ++ i)) ++ (nil #\a nil #\b nil) 2) ++ ++(deftest with-input-from-string.9 ++ (with-input-from-string ++ (s "abc") ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s))) ++ t t t t nil) ++ ++(deftest with-input-from-string.10 ++ :notes (:nil-vectors-are-strings) ++ (with-input-from-string ++ (s (make-array 0 :element-type nil)) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s))) ++ t t t t nil) ++ ++(deftest with-input-from-string.11 ++ (with-input-from-string ++ (s (make-array 3 :element-type 'character :initial-contents "abc")) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "abc") ++ ++(deftest with-input-from-string.12 ++ (with-input-from-string ++ (s (make-array 3 :element-type 'base-char :initial-contents "abc")) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "abc") ++ ++(deftest with-input-from-string.13 ++ (with-input-from-string ++ (s "abcdef" :start 2) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "cdef") ++ ++(deftest with-input-from-string.14 ++ (with-input-from-string ++ (s "abcdef" :end 3) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "abc") ++ ++(deftest with-input-from-string.15 ++ (with-input-from-string ++ (s "abcdef" :start 1 :end 5) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "bcde") ++ ++(deftest with-input-from-string.16 ++ (with-input-from-string ++ (s "abcdef" :start 1 :end nil) ++ (values ++ (notnot (typep s 'stream)) ++ (notnot (typep s 'string-stream)) ++ (notnot (open-stream-p s)) ++ (notnot (input-stream-p s)) ++ (output-stream-p s) ++ (read-line s))) ++ t t t t nil "bcdef") ++ ++(deftest with-input-from-string.17 ++ (let ((i 2)) ++ (values ++ (with-input-from-string ++ (s "abcdef" :index i :start i) ++ (read-char s)) ++ i)) ++ #\c 3) ++ ++;;; Test that there is no implicit tagbody ++ ++(deftest with-input-from-string.18 ++ (block done ++ (tagbody ++ (with-input-from-string ++ (s "abc") ++ (go 1) ++ 1 ++ (return-from done :bad)) ++ 1 ++ (return-from done :good))) ++ :good) ++ ++;;; Free declaration scope ++ ++(deftest with-input-from-string.19 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-input-from-string (s (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++(deftest with-input-from-string.20 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-input-from-string (s "abc" :start (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++(deftest with-input-from-string.21 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-input-from-string (s "abc" :end (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++;;; index is not updated if the form exits abnormally ++ ++(deftest with-input-from-string.22 ++ (let ((i nil)) ++ (values ++ (block done ++ (with-input-from-string (s "abcde" :index i) (return-from done (read-char s)))) ++ i)) ++ #\a nil) ++ ++;;; Test that explicit calls to macroexpand in subforms ++;;; are done in the correct environment ++ ++(deftest with-input-from-string.23 ++ (macrolet ++ ((%m (z) z)) ++ (with-input-from-string (s (expand-in-current-env (%m "123"))) ++ (read-char s))) ++ #\1) ++ ++(deftest with-input-from-string.24 ++ (macrolet ++ ((%m (z) z)) ++ (with-input-from-string (s "123" :start (expand-in-current-env (%m 1))) ++ (read-char s))) ++ #\2) ++ ++(deftest with-input-from-string.25 ++ (macrolet ++ ((%m (z) z)) ++ (with-input-from-string (s "123" :start 0 ++ :end (expand-in-current-env (%m 0))) ++ (read-char s nil nil))) ++ nil) ++ ++ ++;;; FIXME: Add more tests on specialized strings. ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/with-open-file.lsp +@@ -0,0 +1,98 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Tue Jan 27 20:57:05 2004 ++;;;; Contains: Tests of WITH-OPEN-FILE ++ ++(in-package :cl-test) ++ ++;;; For now, omit most of the options combinations, assuming they will ++;;; be tested in OPEN. The tests of OPEN should be ported to here at some ++;;; point. ++ ++(deftest with-open-file.1 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file (s pn :direction :output))) ++ nil) ++ ++(deftest with-open-file.2 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :output) ++ (notnot-mv (output-stream-p s)))) ++ t) ++ ++(deftest with-open-file.3 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :output) ++ (values)))) ++ ++(deftest with-open-file.4 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :output) ++ (values 1 2 3 4 5 6 7 8))) ++ 1 2 3 4 5 6 7 8) ++ ++(deftest with-open-file.5 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn :direction :output) ++ (declare (ignore s)) ++ (declare (optimize)))) ++ nil) ++ ++(deftest with-open-file.6 ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file ++ (s pn (cdr '(nil . :direction)) (car '(:output))) ++ (format s "foo!~%")) ++ (with-open-file (s pn) (read-line s))) ++ "foo!" nil) ++ ++;;; Free declaration scope tests ++ ++(deftest with-open-file.7 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-open-file (s (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++(deftest with-open-file.8 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-open-file (s "with-open-file.lsp" (return-from done x) :input) ++ (declare (special x)))))) ++ :good) ++ ++(deftest with-open-file.9 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-open-file (s "with-open-file.lsp" :direction (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++;;; Test that explicit calls to macroexpand in subforms ++;;; are done in the correct environment ++ ++(deftest with-open-file.10 ++ (macrolet ++ ((%m (z) z)) ++ (let ((pn #p"tmp.dat")) ++ (delete-all-versions pn) ++ (with-open-file (s (expand-in-current-env (%m pn)) ++ :direction :output)))) ++ nil) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/with-open-stream.lsp +@@ -0,0 +1,77 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Dec 13 01:42:59 2004 ++;;;; Contains: Tests of WITH-OPEN-STREAM ++ ++(in-package :cl-test) ++ ++(deftest with-open-stream.1 ++ (with-open-stream (os (make-string-output-stream))) ++ nil) ++ ++(deftest with-open-stream.2 ++ (with-open-stream (os (make-string-output-stream)) ++ (declare (ignore os))) ++ nil) ++ ++(deftest with-open-stream.3 ++ (with-open-stream (os (make-string-output-stream)) ++ (declare (ignore os)) ++ (declare (type string-stream os))) ++ nil) ++ ++(deftest with-open-stream.4 ++ (with-open-stream (os (make-string-output-stream)) ++ (declare (ignore os)) ++ (values))) ++ ++(deftest with-open-stream.5 ++ (with-open-stream (os (make-string-output-stream)) ++ (declare (ignore os)) ++ (values 'a 'b)) ++ a b) ++ ++(deftest with-open-stream.6 ++ (let ((s (make-string-output-stream))) ++ (values ++ (with-open-stream (os s)) ++ (notnot (typep s 'string-stream)) ++ (open-stream-p s))) ++ nil t nil) ++ ++(deftest with-open-stream.7 ++ (let ((s (make-string-input-stream "123"))) ++ (values ++ (with-open-stream (is s) (read-char s)) ++ (notnot (typep s 'string-stream)) ++ (open-stream-p s))) ++ #\1 t nil) ++ ++(deftest with-open-stream.8 ++ (let ((s (make-string-output-stream))) ++ (values ++ (block done ++ (with-open-stream (os s) (return-from done nil))) ++ (notnot (typep s 'string-stream)) ++ (open-stream-p s))) ++ nil t nil) ++ ++(deftest with-open-stream.9 ++ (let ((s (make-string-output-stream))) ++ (values ++ (catch 'done ++ (with-open-stream (os s) (throw 'done nil))) ++ (notnot (typep s 'string-stream)) ++ (open-stream-p s))) ++ nil t nil) ++ ++;;; Free declaration scope ++ ++(deftest with-open-stream.10 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-open-stream (s (return-from done x)) ++ (declare (special x)))))) ++ :good) +--- /dev/null ++++ gcl-2.6.12/ansi-tests/with-output-to-string.lsp +@@ -0,0 +1,129 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sat Feb 14 20:33:51 2004 ++;;;; Contains: Tests of WITH-OUTPUT-TO-STRING ++ ++(in-package :cl-test) ++ ++ ++(deftest with-output-to-string.1 ++ (with-output-to-string (s)) ++ "") ++ ++(deftest with-output-to-string.2 ++ (with-output-to-string (s) (write-char #\3 s)) ++ "3") ++ ++(deftest with-output-to-string.3 ++ (with-output-to-string (s (make-array 10 :fill-pointer 0 ++ :element-type 'character))) ++ nil) ++ ++(deftest with-output-to-string.4 ++ :notes (:allow-nil-arrays :nil-vectors-are-strings) ++ (let ((str (make-array 10 :fill-pointer 0 :element-type 'character))) ++ (values ++ (with-output-to-string ++ (s str :element-type nil) ++ (write-string "abcdef" s)) ++ str)) ++ "abcdef" "abcdef") ++ ++(deftest with-output-to-string.5 ++ (with-output-to-string (s (make-array 10 :fill-pointer 0 ++ :element-type 'character)) ++ (values))) ++ ++(deftest with-output-to-string.6 ++ (with-output-to-string (s (make-array 10 :fill-pointer 0 ++ :element-type 'character)) ++ (values 'a 'b 'c 'd)) ++ a b c d) ++ ++(deftest with-output-to-string.7 ++ (with-output-to-string (s nil :element-type 'character) ++ (write-char #\& s)) ++ "&") ++ ++(deftest with-output-to-string.8 ++ (let ((str (with-output-to-string (s nil :element-type 'base-char) ++ (write-char #\8 s)))) ++ (assert (typep str 'simple-base-string)) ++ str) ++ "8") ++ ++(deftest with-output-to-string.9 ++ :notes (:allow-nil-arrays :nil-vectors-are-strings) ++ (with-output-to-string (s nil :element-type nil)) ++ "") ++ ++(deftest with-output-to-string.10 ++ (let* ((s1 (make-array 20 :element-type 'character ++ :initial-element #\.)) ++ (s2 (make-array 10 :element-type 'character ++ :displaced-to s1 ++ :displaced-index-offset 5 ++ :fill-pointer 0))) ++ ++ (values ++ (with-output-to-string ++ (s s2) ++ (write-string "0123456789" s)) ++ s1 ++ s2)) ++ "0123456789" ++ ".....0123456789....." ++ "0123456789") ++ ++(deftest with-output-to-string.11 ++ (with-output-to-string (s) (declare (optimize safety))) ++ "") ++ ++(deftest with-output-to-string.12 ++ (with-output-to-string (s) (declare (optimize safety)) ++ (declare (optimize (speed 0)))) ++ "") ++ ++(deftest with-output-to-string.13 ++ (with-output-to-string ++ (s) ++ (write-char #\0 s) ++ (write-char #\4 s) ++ (write-char #\9 s)) ++ "049") ++ ++(deftest with-output-to-string.14 ++ (let* ((str1 (make-array '(256) :element-type 'base-char :fill-pointer 0)) ++ (str2 (with-output-to-string ++ (s nil :element-type 'base-char) ++ (loop for i below 256 ++ for c = (code-char i) ++ when (typep c 'base-char) ++ do (progn (write-char c s) ++ (vector-push c str1)))))) ++ (if (string= str1 str2) :good ++ (list str1 str2))) ++ :good) ++ ++;;; Free declaration scope ++ ++(deftest with-output-to-string.15 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good)) ++ (with-output-to-string (s (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ ++(deftest with-output-to-string.16 ++ (block done ++ (let ((x :bad)) ++ (declare (special x)) ++ (let ((x :good) ++ (str (make-array '(10) :element-type 'character ++ :fill-pointer 0))) ++ (with-output-to-string (s str :element-type (return-from done x)) ++ (declare (special x)))))) ++ :good) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/write-char.lsp +@@ -0,0 +1,51 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 20:50:31 2004 ++;;;; Contains: Tests of WRITE-CHAR ++ ++(in-package :cl-test) ++ ++(deftest write-char.1 ++ (loop for i from 0 to 255 ++ for c = (code-char i) ++ when c ++ unless (string= (with-output-to-string ++ (*standard-output*) ++ (write-char c)) ++ (string c)) ++ collect c) ++ nil) ++ ++(deftest write-char.2 ++ (with-input-from-string ++ (is "abcd") ++ (with-output-to-string ++ (os) ++ (let ((*terminal-io* (make-two-way-stream is os))) ++ (write-char #\$ t) ++ (close *terminal-io*)))) ++ "$") ++ ++(deftest write-char.3 ++ (with-output-to-string ++ (*standard-output*) ++ (write-char #\: nil)) ++ ":") ++ ++;;; Error tests ++ ++(deftest write-char.error.1 ++ (signals-error (write-char) program-error) ++ t) ++ ++(deftest write-char.error.2 ++ (signals-error ++ (with-output-to-string ++ (s) ++ (write-char #\a s nil)) ++ program-error) ++ t) ++ ++;;; More tests in other files ++ ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/write-line.lsp +@@ -0,0 +1,165 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Mon Jan 19 06:49:26 2004 ++;;;; Contains: Tests of WRITE-LINE ++ ++(in-package :cl-test) ++ ++(deftest write-line.1 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (write-line "")))) ++ result)) ++ #.(string #\Newline) ++ ("")) ++ ++(deftest write-line.2 ++ :notes (:nil-vectors-are-strings) ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result ++ (multiple-value-list ++ (write-line (make-array '(0) :element-type nil))))) ++ result)) ++ #.(string #\Newline) ++ ("")) ++ ++(deftest write-line.3 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (write-line "abcde")))) ++ result)) ++ #.(concatenate 'string "abcde" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.4 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list (write-line "abcde" s :start 1)))) ++ result)) ++ #.(concatenate 'string "bcde" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.5 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-line "abcde" s :start 1 :end 3)))) ++ result)) ++ #.(concatenate 'string "bc" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.6 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-line "abcde" s :start 1 :end nil)))) ++ result)) ++ #.(concatenate 'string "bcde" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.7 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list (write-line "abcde" s :end 3)))) ++ result)) ++ #.(concatenate 'string "abc" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.8 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-line "abcde" s :end 3 :allow-other-keys nil)))) ++ result)) ++ #.(concatenate 'string "abc" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.9 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result ++ (multiple-value-list ++ (write-line "abcde" s :end 3 :allow-other-keys t :foo 'bar)))) ++ result)) ++ #.(concatenate 'string "abc" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.10 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-line "abcde" s :end 3 :end 2)))) ++ result)) ++ #.(concatenate 'string "abc" (string #\Newline)) ++ ("abcde")) ++ ++(deftest write-line.11 ++ (with-input-from-string ++ (is "abcd") ++ (with-output-to-string ++ (os) ++ (let ((*terminal-io* (make-two-way-stream is os))) ++ (write-line "951" t) ++ (close *terminal-io*)))) ++ #.(concatenate 'string "951" (string #\Newline))) ++ ++(deftest write-line.12 ++ (with-output-to-string ++ (*standard-output*) ++ (write-line "-=|!" nil)) ++ #.(concatenate 'string "-=|!" (string #\Newline))) ++ ++;;; Specialized string tests ++ ++(deftest write-line.13 ++ (do-special-strings ++ (s "abcde" nil) ++ (assert (equal ++ (with-output-to-string ++ (*standard-output*) ++ (multiple-value-list (write-line "abcde"))) ++ #.(concatenate 'string "abcde" (string #\Newline))))) ++ nil) ++ ++;;; Error tests ++ ++(deftest write-line.error.1 ++ (signals-error (write-line) program-error) ++ t) ++ ++(deftest write-line.error.2 ++ (signals-error (write-line "" *standard-output* :start) program-error) ++ t) ++ ++(deftest write-line.error.3 ++ (signals-error (write-line "" *standard-output* :foo nil) program-error) ++ t) ++ ++(deftest write-line.error.4 ++ (signals-error (write-line "" *standard-output* ++ :allow-other-keys nil ++ :foo nil) ++ program-error) ++ t) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/write-sequence.lsp +@@ -0,0 +1,225 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Wed Jan 21 04:07:58 2004 ++;;;; Contains: Tests of WRITE-SEQUENCE ++ ++(in-package :cl-test) ++ ++(defmacro def-write-sequence-test (name input args &rest expected) ++ `(deftest ,name ++ (let ((s ,input)) ++ (with-output-to-string ++ (os) ++ (assert (eq (write-sequence s os ,@args) s)))) ++ ,@expected)) ++ ++;;; on strings ++ ++(def-write-sequence-test write-sequence.string.1 "abcde" () "abcde") ++(def-write-sequence-test write-sequence.string.2 "abcde" (:start 1) "bcde") ++(def-write-sequence-test write-sequence.string.3 "abcde" (:end 3) "abc") ++(def-write-sequence-test write-sequence.string.4 "abcde" ++ (:start 1 :end 4) "bcd") ++(def-write-sequence-test write-sequence.string.5 "abcde" (:end nil) "abcde") ++(def-write-sequence-test write-sequence.string.6 "abcde" (:start 3 :end 3) "") ++(def-write-sequence-test write-sequence.string.7 "abcde" ++ (:end nil :start 1) "bcde") ++(def-write-sequence-test write-sequence.string.8 "abcde" ++ (:allow-other-keys nil) "abcde") ++(def-write-sequence-test write-sequence.string.9 "abcde" ++ (:allow-other-keys t :foo nil) "abcde") ++(def-write-sequence-test write-sequence.string.10 "abcde" ++ (:allow-other-keys t :allow-other-keys nil :foo nil) "abcde") ++(def-write-sequence-test write-sequence.string.11 "abcde" ++ (:bar 'x :allow-other-keys t) "abcde") ++(def-write-sequence-test write-sequence.string.12 "abcde" ++ (:start 1 :end 4 :start 2 :end 3) "bcd") ++(def-write-sequence-test write-sequence.string.13 "" () "") ++ ++(defmacro def-write-sequence-special-test (name string args expected) ++ `(deftest ,name ++ (let ((str ,string) ++ (expected ,expected)) ++ (do-special-strings ++ (s str nil) ++ (let ((out (with-output-to-string ++ (os) ++ (assert (eq (write-sequence s os ,@args) s))))) ++ (assert (equal out expected))))) ++ nil)) ++ ++(def-write-sequence-special-test write-sequence.string.14 "12345" () "12345") ++(def-write-sequence-special-test write-sequence.string.15 "12345" (:start 1 :end 3) "23") ++ ++;;; on lists ++ ++(def-write-sequence-test write-sequence.list.1 (coerce "abcde" 'list) ++ () "abcde") ++(def-write-sequence-test write-sequence.list.2 (coerce "abcde" 'list) ++ (:start 1) "bcde") ++(def-write-sequence-test write-sequence.list.3 (coerce "abcde" 'list) ++ (:end 3) "abc") ++(def-write-sequence-test write-sequence.list.4 (coerce "abcde" 'list) ++ (:start 1 :end 4) "bcd") ++(def-write-sequence-test write-sequence.list.5 (coerce "abcde" 'list) ++ (:end nil) "abcde") ++(def-write-sequence-test write-sequence.list.6 (coerce "abcde" 'list) ++ (:start 3 :end 3) "") ++(def-write-sequence-test write-sequence.list.7 (coerce "abcde" 'list) ++ (:end nil :start 1) "bcde") ++(def-write-sequence-test write-sequence.list.8 () () "") ++ ++ ++;;; on vectors ++ ++(def-write-sequence-test write-sequence.simple-vector.1 ++ (coerce "abcde" 'simple-vector) () "abcde") ++(def-write-sequence-test write-sequence.simple-vector.2 ++ (coerce "abcde" 'simple-vector) (:start 1) "bcde") ++(def-write-sequence-test write-sequence.simple-vector.3 ++ (coerce "abcde" 'simple-vector) (:end 3) "abc") ++(def-write-sequence-test write-sequence.simple-vector.4 ++ (coerce "abcde" 'simple-vector) (:start 1 :end 4) "bcd") ++(def-write-sequence-test write-sequence.simple-vector.5 ++ (coerce "abcde" 'simple-vector) (:end nil) "abcde") ++(def-write-sequence-test write-sequence.simple-vector.6 ++ (coerce "abcde" 'simple-vector) (:start 3 :end 3) "") ++(def-write-sequence-test write-sequence.simple-vector.7 ++ (coerce "abcde" 'simple-vector) (:end nil :start 1) "bcde") ++(def-write-sequence-test write-sequence.simple-vector.8 #() () "") ++ ++;;; on vectors with fill pointers ++ ++(def-write-sequence-test write-sequence.fill-vector.1 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) () "abcde") ++(def-write-sequence-test write-sequence.fill-vector.2 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:start 1) "bcde") ++(def-write-sequence-test write-sequence.fill-vector.3 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:end 3) "abc") ++(def-write-sequence-test write-sequence.fill-vector.4 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:start 1 :end 4) "bcd") ++(def-write-sequence-test write-sequence.fill-vector.5 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:end nil) "abcde") ++(def-write-sequence-test write-sequence.fill-vector.6 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:start 3 :end 3) "") ++(def-write-sequence-test write-sequence.fill-vector.7 ++ (make-array 10 :initial-contents "abcde " :fill-pointer 5) ++ (:end nil :start 1) "bcde") ++ ++;;; on bit vectors ++ ++(defmacro def-write-sequence-bv-test (name input args expected) ++ `(deftest ,name ++ (let ((s ,input) ++ (expected ,expected)) ++ (with-open-file ++ (os "tmp.dat" :direction :output ++ :element-type '(unsigned-byte 8) ++ :if-exists :supersede) ++ (assert (eq (write-sequence s os ,@args) s))) ++ (with-open-file ++ (is "tmp.dat" :direction :input ++ :element-type '(unsigned-byte 8)) ++ (loop for i from 0 below (length expected) ++ for e = (elt expected i) ++ always (eql (read-byte is) e)))) ++ t)) ++ ++(def-write-sequence-bv-test write-sequence.bv.1 #*00111010 ++ () #*00111010) ++(def-write-sequence-bv-test write-sequence.bv.2 #*00111010 ++ (:start 1) #*0111010) ++(def-write-sequence-bv-test write-sequence.bv.3 #*00111010 ++ (:end 5) #*00111) ++(def-write-sequence-bv-test write-sequence.bv.4 #*00111010 ++ (:start 1 :end 6) #*01110) ++(def-write-sequence-bv-test write-sequence.bv.5 #*00111010 ++ (:start 1 :end nil) #*0111010) ++(def-write-sequence-bv-test write-sequence.bv.6 #*00111010 ++ (:start 1 :end nil :end 4) #*0111010) ++ ++ ++;;; Error tests ++ ++(deftest write-sequence.error.1 ++ (signals-error (write-sequence) program-error) ++ t) ++ ++(deftest write-sequence.error.2 ++ (signals-error (write-sequence "abcde") program-error) ++ t) ++ ++(deftest write-sequence.error.3 ++ (signals-error (write-sequence '(#\a . #\b) *standard-output*) type-error) ++ t) ++ ++(deftest write-sequence.error.4 ++ (signals-error (write-sequence #\a *standard-output*) type-error) ++ t) ++ ++(deftest write-sequence.error.5 ++ (signals-error (write-sequence "ABC" *standard-output* :start -1) type-error) ++ t) ++ ++(deftest write-sequence.error.6 ++ (signals-error (write-sequence "ABC" *standard-output* :start 'x) type-error) ++ t) ++ ++(deftest write-sequence.error.7 ++ (signals-error (write-sequence "ABC" *standard-output* :start 0.0) ++ type-error) ++ t) ++ ++(deftest write-sequence.error.8 ++ (signals-error (write-sequence "ABC" *standard-output* :end -1) ++ type-error) ++ t) ++ ++(deftest write-sequence.error.9 ++ (signals-error (write-sequence "ABC" *standard-output* :end 'x) ++ type-error) ++ t) ++ ++(deftest write-sequence.error.10 ++ (signals-error (write-sequence "ABC" *standard-output* :end 2.0) ++ type-error) ++ t) ++ ++(deftest write-sequence.error.11 ++ (signals-error (write-sequence "abcde" *standard-output* ++ :foo nil) program-error) ++ t) ++ ++(deftest write-sequence.error.12 ++ (signals-error (write-sequence "abcde" *standard-output* ++ :allow-other-keys nil :foo t) ++ program-error) ++ t) ++ ++(deftest write-sequence.error.13 ++ (signals-error (write-sequence "abcde" *standard-output* :start) ++ program-error) ++ t) ++ ++(deftest write-sequence.error.14 ++ (check-type-error #'(lambda (x) (write-sequence x *standard-output*)) ++ #'sequencep) ++ nil) ++ ++(deftest write-sequence.error.15 ++ (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output* ++ :start x)) ++ (typef 'unsigned-byte)) ++ nil) ++ ++(deftest write-sequence.error.16 ++ (check-type-error #'(lambda (x) (write-sequence "abcde" *standard-output* ++ :end x)) ++ (typef '(or null unsigned-byte))) ++ nil) ++ +--- /dev/null ++++ gcl-2.6.12/ansi-tests/write-string.lsp +@@ -0,0 +1,156 @@ ++;-*- Mode: Lisp -*- ++;;;; Author: Paul Dietz ++;;;; Created: Sun Jan 18 21:13:32 2004 ++;;;; Contains: Tests of WRITE-STRING ++ ++(in-package :cl-test) ++ ++(deftest write-string.1 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (write-string "")))) ++ result)) ++ "" ("")) ++ ++(deftest write-string.2 ++ :notes (:nil-vectors-are-strings) ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result ++ (multiple-value-list ++ (write-string (make-array '(0) :element-type nil))))) ++ result)) ++ "" ("")) ++ ++(deftest write-string.3 ++ (let (result) ++ (values ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (write-string "abcde")))) ++ result)) ++ "abcde" ("abcde")) ++ ++(deftest write-string.4 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list (write-string "abcde" s :start 1)))) ++ result)) ++ "bcde" ("abcde")) ++ ++(deftest write-string.5 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-string "abcde" s :start 1 :end 3)))) ++ result)) ++ "bc" ("abcde")) ++ ++(deftest write-string.6 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-string "abcde" s :start 1 :end nil)))) ++ result)) ++ "bcde" ("abcde")) ++ ++(deftest write-string.7 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list (write-string "abcde" s :end 3)))) ++ result)) ++ "abc" ("abcde")) ++ ++(deftest write-string.8 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-string "abcde" s :end 3 :allow-other-keys nil)))) ++ result)) ++ "abc" ("abcde")) ++ ++(deftest write-string.9 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result ++ (multiple-value-list ++ (write-string "abcde" s :end 3 :allow-other-keys t :foo 'bar)))) ++ result)) ++ "abc" ("abcde")) ++ ++(deftest write-string.10 ++ (let (result) ++ (values ++ (with-output-to-string ++ (s) ++ (setq result (multiple-value-list ++ (write-string "abcde" s :end 3 :end 2)))) ++ result)) ++ "abc" ("abcde")) ++ ++(deftest write-string.11 ++ (with-input-from-string ++ (is "abcd") ++ (with-output-to-string ++ (os) ++ (let ((*terminal-io* (make-two-way-stream is os))) ++ (write-string "951" t) ++ (close *terminal-io*)))) ++ "951") ++ ++(deftest write-string.12 ++ (with-output-to-string ++ (*standard-output*) ++ (write-string "-=|!" nil)) ++ "-=|!") ++ ++;;; Specialized string tests ++ ++(deftest write-string.13 ++ (let (result) ++ (do-special-strings ++ (s "abcde" nil) ++ (assert (equal ++ (with-output-to-string ++ (*standard-output*) ++ (setq result (multiple-value-list (write-string "abcde")))) ++ "abcde")) ++ (assert (equal result '("abcde"))))) ++ nil) ++ ++;;; Error tests ++ ++(deftest write-string.error.1 ++ (signals-error (write-string) program-error) ++ t) ++ ++(deftest write-string.error.2 ++ (signals-error (write-string "" *standard-output* :start) program-error) ++ t) ++ ++(deftest write-string.error.3 ++ (signals-error (write-string "" *standard-output* :foo nil) program-error) ++ t) ++ ++(deftest write-string.error.4 ++ (signals-error (write-string "" *standard-output* ++ :allow-other-keys nil ++ :foo nil) ++ program-error) ++ t) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp +@@ -556,6 +556,14 @@ + ((null type) nil) + ((setq f (assoc type *type-alist* :test 'equal)) + (list (cdr f) x)) ++ ((setq f (when (symbolp type) (get type 'si::type-predicate))) ++ (list f x)) ++ ((and (consp type) (eq (car type) 'or)) ++ `(or ,@(mapcar (lambda (y) `(typep ,x ',y)) (cdr type)))) ++ ((and (consp type) (eq (car type) 'member)) ++ `(or ,@(mapcar (lambda (y) `(eql ,x ',y)) (cdr type)))) ++ ((and (consp type) (eq (car type) 'eql)) ++ `(eql ,x ',(cadr type))) + ((and (consp type) + (or (and (eq (car type) 'vector) + (null (cddr type))) +--- gcl-2.6.12.orig/cmpnew/gcl_cmplabel.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmplabel.lsp +@@ -44,7 +44,7 @@ + `(when (cdr ,label) (wt-nl "goto T" (car ,label) ";")(wt-nl1 "T" (car ,label) ":;"))) + + (defmacro wt-go (label) +- `(progn (rplacd ,label t) (wt "goto T" (car ,label) ";"))) ++ `(progn (rplacd ,label t) (wt "goto T" (car ,label) ";")(wt-nl))) + + + (defvar *restore-avma* nil) +--- gcl-2.6.12.orig/cmpnew/gcl_cmplam.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmplam.lsp +@@ -407,6 +407,12 @@ + (c2lambda-expr-without-key lambda-list body))) + )) + ++(defun decl-body-safety (body) ++ (case (car body) ++ (decl-body (or (cadr (assoc 'safety (caddr body))) 0)) ++ ((let let*) (decl-body-safety (car (last body)))) ++ (otherwise 0))) ++ + (defun c2lambda-expr-without-key + (lambda-list body + &aux (requireds (car lambda-list)) +@@ -439,7 +445,7 @@ + (when rest (do-decl rest)) + ) + ;;; check arguments +- (when (or *safe-compile* *compiler-check-args*) ++ (when (or *safe-compile* *compiler-check-args* (plusp (decl-body-safety body)));FIXME + (cond ((or rest optionals) + (when requireds + (wt-nl "if(vs_top-vs_base<" (length requireds) +@@ -448,7 +454,7 @@ + (wt-nl "if(vs_top-vs_base>" + (+ (length requireds) (length optionals)) + ") too_many_arguments();"))) +- (t (wt-nl "check_arg(" (length requireds) ");")))) ++ (t (when requireds (wt-nl "check_arg(" (length requireds) ");"))))) + + ;;; Allocate the parameters. + (dolist** (var requireds) (setf (var-ref var) (vs-push))) +@@ -562,7 +568,7 @@ + (when (cadddr kwd) (do-decl (cadddr kwd)))) + ) + ;;; Check arguments. +- (when (and (or *safe-compile* *compiler-check-args*) requireds) ++ (when (and (or *safe-compile* *compiler-check-args* (plusp (decl-body-safety body))) requireds);FIXME + (when requireds + (wt-nl "if(vs_top-vs_base<" (length requireds) + ") too_few_arguments();"))) +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -52,7 +52,7 @@ + (defvar *cmpinclude-string* + (si::file-to-string + (namestring +- (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :parent "h")) ++ (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :back "h")) + :name "cmpinclude" :type "h")))) + + +@@ -160,7 +160,7 @@ + + + (defun compile-file1 (input-pathname +- &key (output-file (truename input-pathname)) ++ &key (output-file (merge-pathnames ".o" (truename input-pathname))) + (o-file t) + (c-file *default-c-file*) + (h-file *default-h-file*) +@@ -175,7 +175,7 @@ + (*c-debug* c-debug) + (*compile-print* (or print *compile-print*)) + (*package* *package*) +- (*DEFAULT-PATHNAME-DEFAULTS* #"") ++ (*DEFAULT-PATHNAME-DEFAULTS* #p"") + (*data* (list (make-array 50 :fill-pointer 0 :adjustable t) nil nil)) + *init-name* + (*fasd-data* *fasd-data*) +@@ -186,25 +186,25 @@ + (cond (*compiler-in-use* + (format t "~&The compiler was called recursively.~%~ + Cannot compile ~a.~%" +- (namestring (merge-pathnames input-pathname #".lsp"))) ++ (namestring (merge-pathnames input-pathname #p".lsp"))) + (setq *error-p* t) + (return-from compile-file1 (values))) + (t (setq *error-p* nil) + (setq *compiler-in-use* t))) + +- (unless (probe-file (merge-pathnames input-pathname #".lsp")) ++ (unless (probe-file (merge-pathnames input-pathname #p".lsp")) + (format t "~&The source file ~a is not found.~%" +- (namestring (merge-pathnames input-pathname #".lsp"))) ++ (namestring (merge-pathnames input-pathname #p".lsp"))) + (setq *error-p* t) + (return-from compile-file1 (values))) + + (when *compile-verbose* +- (format t "~&Compiling ~a.~%" (namestring (merge-pathnames input-pathname #".lsp")))) ++ (format t "~&Compiling ~a.~%" (namestring (merge-pathnames input-pathname #p".lsp")))) + + (and *record-call-info* (clear-call-table)) + + (with-open-file +- (*compiler-input* (merge-pathnames input-pathname #".lsp")) ++ (*compiler-input* (merge-pathnames input-pathname #p".lsp")) + + + (cond ((numberp *split-files*) +@@ -232,8 +232,11 @@ Cannot compile ~a.~%" + (device (or (and (not (null output-file)) + (pathname-device output-file)) + (pathname-device input-pathname))) ++ (typ (or (and (not (null output-file)) ++ (pathname-type output-file)) ++ "o")) + +- (o-pathname (get-output-pathname o-file "o" name dir device)) ++ (o-pathname (get-output-pathname o-file typ name dir device)) + (c-pathname (get-output-pathname c-file "c" name dir device)) + (h-pathname (get-output-pathname h-file "h" name dir device)) + (data-pathname (get-output-pathname data-file "data" name dir device))) +@@ -351,7 +354,7 @@ Cannot compile ~a.~%" + (wt-data1 form) ;; this binds all the print stuff + )) + +-(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #".")) ++(defun compile (name &optional def &aux tem gaz (*default-pathname-defaults* #p".")) + + (cond ((not(symbolp name)) (error "Must be a name")) + ((and (consp def) +@@ -797,7 +800,7 @@ Cannot compile ~a.~%" + + (with-open-file (st (namestring map) :direction :output)) + (safe-system +- (let* ((par (namestring (make-pathname :directory '(:parent)))) ++ (let* ((par (namestring (make-pathname :directory '(:back)))) + (i (concatenate 'string " " par)) + (j (concatenate 'string " " si::*system-directory* par))) + (format nil "~a ~a ~a ~a -L~a ~a ~a ~a" +--- gcl-2.6.12.orig/cmpnew/gcl_cmpopt.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpopt.lsp +@@ -1170,6 +1170,14 @@ type_of(#0)==t_complex") + (push '((t) t #.(flags ans)"coerce_to_string(#0)") + (get 'string 'inline-always)) + ++;;PATHNAME-DESIGNATORP ++(push '((t) boolean #.(flags)"pathname_designatorp(#0)") ++ (get 'si::pathname-designatorp 'inline-always)) ++ ++;;PATHNAMEP ++(push '((t) boolean #.(flags)"pathnamep(#0)") ++ (get 'pathnamep 'inline-always)) ++ + ;;STRINGP + (push '((t) boolean #.(flags)"type_of(#0)==t_string") + (get 'stringp 'inline-always)) +--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp +@@ -209,7 +209,7 @@ + + (cond ((not sp) "code") + ((not (pathnamep p)) (init-name (pathname p) sp gp dc nt)) +- (gp (init-name (truename (merge-pathnames p #".lsp")) sp nil dc nt)) ++ (gp (init-name (truename (merge-pathnames p #p".lsp")) sp nil dc nt)) + ((pathname-type p) + (init-name (make-pathname + :host (pathname-host p) +--- gcl-2.6.12.orig/cmpnew/gcl_collectfn.lsp ++++ gcl-2.6.12/cmpnew/gcl_collectfn.lsp +@@ -240,22 +240,20 @@ + + (defvar *warn-on-multiple-fn-definitions* t) + +-(defun add-fn-data (lis &aux tem file) +- (let ((file (and (setq file (si::fp-input-stream *standard-input*)) +- (truename file)))) ++(defun add-fn-data (lis &aux tem (file *load-truename*)) + (dolist (v lis) +- (cond ((eql (fn-name v) 'other-form) +- (setf (fn-name v) (intern +- (concatenate 'string "OTHER-FORM-" +- (namestring file)))) +- (setf (get (fn-name v) 'other-form) t))) +- (setf (gethash (fn-name v) *call-table*) v) +- (when *warn-on-multiple-fn-definitions* +- (when (setq tem (gethash (fn-name v) *file-table*)) +- (unless (equal tem file) +- (warn 'simple-warning :format-control "~% ~a redefined in ~a. Originally in ~a." +- :format-arguments (list (fn-name v) file tem))))) +- (setf (gethash (fn-name v) *file-table*) file)))) ++ (cond ((eql (fn-name v) 'other-form) ++ (setf (fn-name v) (intern ++ (concatenate 'string "OTHER-FORM-" ++ (namestring file)))) ++ (setf (get (fn-name v) 'other-form) t))) ++ (setf (gethash (fn-name v) *call-table*) v) ++ (when *warn-on-multiple-fn-definitions* ++ (when (setq tem (gethash (fn-name v) *file-table*)) ++ (unless (equal tem file) ++ (warn 'simple-warning :format-control "~% ~a redefined in ~a. Originally in ~a." ++ :format-arguments (list (fn-name v) file tem))))) ++ (setf (gethash (fn-name v) *file-table*) file))) + + (defun dump-fn-data (&optional (file "fn-data.lsp") + &aux (*package* (find-package "COMPILER")) +--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp ++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp +@@ -20,7 +20,6 @@ + (DEFSYSFUN 'CHAR-NAME "Lchar_name" '(T) 'T NIL NIL) + (DEFSYSFUN 'RASSOC-IF "Lrassoc_if" '(T T) 'T NIL NIL) + (DEFSYSFUN 'MAKE-LIST "Lmake_list" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'HOST-NAMESTRING "Lhost_namestring" '(T) 'STRING NIL NIL) + (DEFSYSFUN 'MAKE-ECHO-STREAM "Lmake_echo_stream" '(T T) 'T NIL NIL) + ;(DEFSYSFUN 'NTH "Lnth" '(T T) 'T NIL NIL) + (DEFSYSFUN 'SIN "Lsin" '(T) 'T NIL NIL) +@@ -31,8 +30,6 @@ + ;#-clcs (DEFSYSFUN 'OPEN "Lopen" '(T *) 'T NIL NIL) + (DEFSYSFUN 'BOTH-CASE-P "Lboth_case_p" '(T) 'T NIL T) + (DEFSYSFUN 'NULL "Lnull" '(T) 'T NIL T) +-(DEFSYSFUN 'RENAME-FILE "Lrename_file" '(T T) 'T NIL NIL) +-(DEFSYSFUN 'FILE-AUTHOR "Lfile_author" '(T) 'T NIL NIL) + (DEFSYSFUN 'STRING-CAPITALIZE "Lstring_capitalize" '(T *) 'STRING NIL + NIL) + (DEFSYSFUN 'MACROEXPAND "Lmacroexpand" '(T *) '(VALUES T T) NIL NIL) +@@ -45,7 +42,6 @@ + (DEFSYSFUN 'LENGTH "Llength" '(T) 'FIXNUM T NIL) + (DEFSYSFUN 'RASSOC "Lrassoc" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'PPRINT "Lpprint" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'PATHNAME-HOST "Lpathname_host" '(T) 'T NIL NIL) + (DEFSYSFUN 'NSUBST-IF-NOT "Lnsubst_if_not" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'FILE-POSITION "Lfile_position" '(T *) 'T NIL NIL) + (DEFSYSFUN 'STRING< "Lstring_l" '(T T *) 'T NIL NIL) +@@ -58,14 +54,11 @@ + (DEFSYSFUN 'STRING>= "Lstring_ge" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'REALPART "Lrealpart" '(T) 'T NIL NIL) + ;;broken on suns.. +-;(DEFSYSFUN 'USER-HOMEDIR-PATHNAME "Luser_homedir_pathname" '(*) 'T NIL +-; NIL) + (DEFSYSFUN 'NBUTLAST "Lnbutlast" '(T *) 'T NIL NIL) + (DEFSYSFUN 'ARRAY-DIMENSION "Larray_dimension" '(T T) 'FIXNUM NIL NIL) + (DEFSYSFUN 'CDR "Lcdr" '(T) 'T NIL NIL) + ;(DEFSYSFUN 'EQL "Leql" '(T T) 'T NIL T) + (DEFSYSFUN 'LOG "Llog" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'DIRECTORY "Ldirectory" '(T) 'T NIL NIL) + (DEFSYSFUN 'STRING-NOT-EQUAL "Lstring_not_equal" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'SHADOWING-IMPORT "Lshadowing_import" '(T *) 'T NIL NIL) + (DEFSYSFUN 'MAPC "Lmapc" '(T T *) 'T NIL NIL) +@@ -78,8 +71,6 @@ + (DEFSYSFUN 'MAKE-SYMBOL "Lmake_symbol" '(T) 'T NIL NIL) + (DEFSYSFUN 'STRING-RIGHT-TRIM "Lstring_right_trim" '(T T) 'STRING NIL + NIL) +-(DEFSYSFUN 'ENOUGH-NAMESTRING "Lenough_namestring" '(T *) 'STRING NIL +- NIL) + (DEFSYSFUN 'PRINT "Lprint" '(T *) 'T NIL NIL) + (DEFSYSFUN 'CDDAAR "Lcddaar" '(T) 'T NIL NIL) + (DEFSYSFUN 'CDADAR "Lcdadar" '(T) 'T NIL NIL) +@@ -187,7 +178,6 @@ + NIL) + (DEFSYSFUN 'COPY-ALIST "Lcopy_alist" '(T) 'T NIL NIL) + (DEFSYSFUN 'ATAN "Latan" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'DELETE-FILE "Ldelete_file" '(T) 'T NIL NIL) + (DEFSYSFUN 'FLOAT-RADIX "Lfloat_radix" '(T) 'FIXNUM NIL NIL) + (DEFSYSFUN 'SYMBOL-NAME "Lsymbol_name" '(T) 'STRING NIL NIL) + (DEFSYSFUN 'CLEAR-INPUT "Lclear_input" '(*) 'T NIL NIL) +@@ -215,8 +205,6 @@ + (DEFSYSFUN 'SXHASH "Lsxhash" '(T) 'FIXNUM NIL NIL) + (DEFSYSFUN 'LISTEN "Llisten" '(*) 'T NIL NIL) + (DEFSYSFUN 'ARRAYP "Larrayp" '(T) 'T NIL T) +-(DEFSYSFUN 'MAKE-PATHNAME "Lmake_pathname" '(*) 'T NIL NIL) +-(DEFSYSFUN 'PATHNAME-TYPE "Lpathname_type" '(T) 'T NIL NIL) + (DEFSYSFUN 'FUNCALL "Lfuncall" '(T *) 'T NIL NIL) + (DEFSYSFUN 'CLRHASH "Lclrhash" '(T) 'T NIL NIL) + (DEFSYSFUN 'GRAPHIC-CHAR-P "Lgraphic_char_p" '(T) 'T NIL T) +@@ -227,14 +215,12 @@ + (DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'COMPLEXP "Lcomplexp" '(T) 'T NIL T) + (DEFSYSFUN 'READ-LINE "Lread_line" '(*) '(VALUES T T) NIL NIL) +-(DEFSYSFUN 'PATHNAMEP "Lpathnamep" '(T) 'T NIL T) + (DEFSYSFUN 'MAX "Lmax" '(T *) 'T NIL NIL) + (DEFSYSFUN 'IN-PACKAGE "Lin_package" '(T *) 'T NIL NIL) + (DEFSYSFUN 'READTABLEP "Lreadtablep" '(T) 'T NIL T) + (DEFSYSFUN 'FLOAT-SIGN "Lfloat_sign" '(T *) 'T NIL NIL) + (DEFSYSFUN 'CHARACTERP "Lcharacterp" '(T) 'T NIL T) + (DEFSYSFUN 'READ "Lread" '(*) 'T NIL NIL) +-(DEFSYSFUN 'NAMESTRING "Lnamestring" '(T) 'T NIL NIL) + (DEFSYSFUN 'UNREAD-CHAR "Lunread_char" '(T *) 'T NIL NIL) + (DEFSYSFUN 'CDAAR "Lcdaar" '(T) 'T NIL NIL) + (DEFSYSFUN 'CADAR "Lcadar" '(T) 'T NIL NIL) +@@ -267,10 +253,8 @@ + (DEFSYSFUN 'PACKAGEP "Lpackagep" '(T) 'T NIL T) + (DEFSYSFUN 'INPUT-STREAM-P "Linput_stream_p" '(T) 'T NIL T) + (DEFSYSFUN '>= "Lmonotonically_nonincreasing" '(T *) 'T NIL T) +-(DEFSYSFUN 'PATHNAME "Lpathname" '(T) 'T NIL NIL) + ;(DEFSYSFUN 'EQ "Leq" '(T T) 'T NIL T) + (DEFSYSFUN 'MAKE-CHAR "Lmake_char" '(T *) 'CHARACTER NIL NIL) +-(DEFSYSFUN 'FILE-NAMESTRING "Lfile_namestring" '(T) 'STRING NIL NIL) + (DEFSYSFUN 'CHARACTER "Lcharacter" '(T) 'CHARACTER NIL NIL) + (DEFSYSFUN 'SYMBOL-FUNCTION "Lsymbol_function" '(T) 'T NIL NIL) + (DEFSYSFUN 'CONSTANTP "Lconstantp" '(T) 'T NIL T) +@@ -307,13 +291,9 @@ + (DEFSYSFUN 'NUMBERP "Lnumberp" '(T) 'T NIL T) + (DEFSYSFUN 'COPY-READTABLE "Lcopy_readtable" '(*) 'T NIL NIL) + (DEFSYSFUN 'RANDOM-STATE-P "Lrandom_state_p" '(T) 'T NIL T) +-(DEFSYSFUN 'DIRECTORY-NAMESTRING "Ldirectory_namestring" '(T) 'STRING +- NIL NIL) + (DEFSYSFUN 'STANDARD-CHAR-P "Lstandard_char_p" '(T) 'T NIL T) +-(DEFSYSFUN 'TRUENAME "Ltruename" '(T) 'T NIL NIL) + (DEFSYSFUN 'IDENTITY "Lidentity" '(T) 'T NIL NIL) + (DEFSYSFUN 'NREVERSE "Lnreverse" '(T) 'T NIL NIL) +-(DEFSYSFUN 'PATHNAME-DEVICE "Lpathname_device" '(T) 'T NIL NIL) + (DEFSYSFUN 'UNINTERN "Lunintern" '(T *) 'T NIL NIL) + (DEFSYSFUN 'UNEXPORT "Lunexport" '(T *) 'T NIL NIL) + (DEFSYSFUN 'FLOAT-PRECISION "Lfloat_precision" '(T) 'FIXNUM NIL NIL) +@@ -324,7 +304,7 @@ + (DEFSYSFUN 'READ-CHAR-NO-HANG "Lread_char_no_hang" '(*) 'T NIL NIL) + (DEFSYSFUN 'FRESH-LINE "Lfresh_line" '(*) 'T NIL NIL) + (DEFSYSFUN 'WRITE-CHAR "Lwrite_char" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'PARSE-NAMESTRING "Lparse_namestring" '(T *) 'T NIL NIL) ++;(DEFSYSFUN 'PARSE-NAMESTRING "Lparse_namestring" '(T *) 'T NIL NIL) + (DEFSYSFUN 'STRING-NOT-LESSP "Lstring_not_lessp" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'CHAR "Lchar" '(T T) 'CHARACTER NIL NIL) + (DEFSYSFUN 'AREF "Laref" '(T *) 'T NIL NIL) +@@ -338,7 +318,6 @@ + (DEFSYSFUN 'DIGIT-CHAR-P "Ldigit_char_p" '(T *) 'T NIL NIL) + ;; #-clcs (DEFSYSFUN 'ERROR "Lerror" '(T *) 'T NIL NIL) + (DEFSYSFUN 'CHAR/= "Lchar_neq" '(T *) 'T NIL T) +-(DEFSYSFUN 'PATHNAME-DIRECTORY "Lpathname_directory" '(T) 'T NIL NIL) + (DEFSYSFUN 'CDAAAR "Lcdaaar" '(T) 'T NIL NIL) + (DEFSYSFUN 'CADAAR "Lcadaar" '(T) 'T NIL NIL) + (DEFSYSFUN 'CAADAR "Lcaadar" '(T) 'T NIL NIL) +@@ -349,7 +328,6 @@ + (DEFSYSFUN 'FORMAT "Lformat" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'COMPILED-FUNCTION-P "Lcompiled_function_p" '(T) 'T NIL T) + (DEFSYSFUN 'SUBLIS "Lsublis" '(T T *) 'T NIL NIL) +-(DEFSYSFUN 'PATHNAME-NAME "Lpathname_name" '(T) 'T NIL NIL) + (DEFSYSFUN 'IMPORT "Limport" '(T *) 'T NIL NIL) + (DEFSYSFUN 'LOGXOR "Llogxor" '(*) 'T NIL NIL) + (DEFSYSFUN 'RASSOC-IF-NOT "Lrassoc_if_not" '(T T) 'T NIL NIL) +@@ -366,9 +344,7 @@ + (DEFSYSFUN 'GET-PROPERTIES "Lget_properties" '(T T) '* NIL NIL) + (DEFSYSFUN 'STRING<= "Lstring_le" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'EVALHOOK "siLevalhook" '(T T T *) 'T NIL NIL) +-(DEFSYSFUN 'FILE-WRITE-DATE "Lfile_write_date" '(T) 'T NIL NIL) + (DEFSYSFUN 'LOGCOUNT "Llogcount" '(T) 'T NIL NIL) +-(DEFSYSFUN 'MERGE-PATHNAMES "Lmerge_pathnames" '(T *) 'T NIL NIL) + (DEFSYSFUN 'MEMBER-IF "Lmember_if" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'READ-BYTE "Lread_byte" '(T *) 'T NIL NIL) + (DEFSYSFUN 'SIMPLE-VECTOR-P "Lsimple_vector_p" '(T) 'T NIL T) +@@ -381,10 +357,8 @@ + (DEFSYSFUN 'GET "Lget" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'MOD "Lmod" '(T T) 'T NIL NIL) + (DEFSYSFUN 'DIGIT-CHAR "Ldigit_char" '(T *) 'CHARACTER NIL NIL) +-(DEFSYSFUN 'PROBE-FILE "Lprobe_file" '(T) 'T NIL NIL) + (DEFSYSFUN 'STRING-LEFT-TRIM "Lstring_left_trim" '(T T) 'STRING NIL + NIL) +-(DEFSYSFUN 'PATHNAME-VERSION "Lpathname_version" '(T) 'T NIL NIL) + (DEFSYSFUN 'WRITE-LINE "Lwrite_line" '(T *) 'T NIL NIL) + (DEFSYSFUN 'EVAL "Leval" '(T) 'T NIL NIL) + (DEFSYSFUN 'ATOM "Latom" '(T) 'T NIL T) +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -4183,7 +4183,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu + #fi + # subst GCC not only under 386-linux, but where available -- CM + +-TCFLAGS="-fsigned-char" ++TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" + + if test "$GCC" = "yes" ; then + +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -483,7 +483,7 @@ AC_SUBST(CC) + #fi + # subst GCC not only under 386-linux, but where available -- CM + +-TCFLAGS="-fsigned-char" ++TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" + + if test "$GCC" = "yes" ; then + +--- gcl-2.6.12.orig/h/att_ext.h ++++ gcl-2.6.12/h/att_ext.h +@@ -116,25 +116,14 @@ float object_to_float(); + double object_to_double(); + + /* error.c */ +-EXTER object sKerror; +-EXTER object sKwrong_type_argument; + EXTER object sKcatch; + EXTER object sKprotect; + EXTER object sKcatchall; +-EXTER object sKtoo_few_arguments; +-EXTER object sKtoo_many_arguments; +-EXTER object sKunexpected_keyword; +-EXTER object sKinvalid_form; +-EXTER object sKunbound_variable; +-EXTER object sKinvalid_variable; +-EXTER object sKundefined_function; +-EXTER object sKinvalid_function; + EXTER object sKdatum; + EXTER object sKexpected_type; + EXTER object sKpackage; + EXTER object sKformat_control; + EXTER object sKformat_arguments; +-EXTER object sKpackage_error; + object wrong_type_argument(); + EXTER object sSuniversal_error_handler; + +@@ -394,10 +383,11 @@ EXTER object sKname; + EXTER object sKtype; + EXTER object sKversion; + EXTER object sKdefaults; +-EXTER object sKroot; +-EXTER object sKcurrent; +-EXTER object sKparent; +-EXTER object sKper; ++ ++EXTER object sKabsolute; ++EXTER object sKrelative; ++EXTER object sKup; ++ + /* object parse_namestring(); */ + object coerce_to_pathname(); + /* object default_device(); */ +--- gcl-2.6.12.orig/h/compdefs.h ++++ gcl-2.6.12/h/compdefs.h +@@ -115,3 +115,5 @@ SIGNED_CHAR(x) + FEerror(x,y...) + FEwrong_type_argument(x,y) + BIT_ENDIAN(x) ++pathname_designatorp(x) ++pathnamep(x) +--- gcl-2.6.12.orig/h/error.h ++++ gcl-2.6.12/h/error.h +@@ -22,6 +22,7 @@ PFN(numberp) + PFN(characterp) + PFN(symbolp) + PFN(stringp) ++PFN(pathnamep) + PFN(string_symbolp) + PFN(packagep) + PFN(consp) +@@ -52,6 +53,7 @@ PFN(functionp) + #define check_type_character(a_) TPE(a_,characterp_fn,sLcharacter) + #define check_type_sym(a_) TPE(a_,symbolp_fn,sLsymbol) + #define check_type_string(a_) TPE(a_,stringp_fn,sLstring) ++#define check_type_pathname(a_) TPE(a_,pathnamep_fn,sLpathname) + #define check_type_or_string_symbol(a_) TPE(a_,string_symbolp_fn,TSor_symbol_string) + #define check_type_or_symbol_string(a_) TPE(a_,string_symbolp_fn,TSor_symbol_string) + #define check_type_or_pathname_string_symbol_stream(a_) TPE(a_,pathname_string_symbol_streamp_fn,TSor_pathname_string_symbol_stream) +@@ -79,12 +81,6 @@ PFN(functionp) + set_type_of((a_),t_fixnum);\ + (a_)->FIX.FIXVAL=(b_);} + +-/*FIXME the stack stuff is dangerous It works for error handling, but +- simple errors may evan pass the format tring up the stack as a slot +- in ansi*/ +-/* #define TYPE_ERROR(a_,b_) {stack_string(tp_err,"~S is not of type ~S.");\ */ +-/* Icall_error_handler(sKwrong_type_argument,tp_err,2,(a_),(b_));} */ +- + object ihs_top_function_name(ihs_ptr h); + #define FEerror(a_,b_...) Icall_error_handler(sLerror,null_string,\ + 4,sKformat_control,make_simple_string(a_),sKformat_arguments,list(b_)) +--- gcl-2.6.12.orig/h/lu.h ++++ gcl-2.6.12/h/lu.h +@@ -301,7 +301,7 @@ struct pathname { + object pn_name; + object pn_type; + object pn_version; +- SPAD; ++ object pn_namestring; + }; + + struct cfun { +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -47,12 +47,6 @@ EXTER object user_package; + else *__p++ = va_arg(ap,object);} \ + va_end(ap) + +-/* #undef endp */ +- +-/* #define endp(obje) ((enum type)((endp_temp = (obje))->d.t) == t_cons ? \ */ +-/* FALSE : endp_temp == Cnil ? TRUE : \ */ +-/* endp1(endp_temp)) */ +- + #ifndef NO_DEFUN + #undef DEFUN + #define DEFUN(string,ret,fname,pack,min,max, flags, ret0a0,a12,a34,a56,doc) ret fname +@@ -234,7 +228,7 @@ EXTER bool left_trim; + EXTER bool right_trim; + int (*casefun)(); + +-#define Q_SIZE 128 ++#define Q_SIZE 256 + #define IS_SIZE 256 + + struct printStruct { +@@ -300,6 +294,8 @@ gcl_init_cmp_anon(void); + + #include "gmp_wrappers.h" + ++char FN1[PATH_MAX],FN2[PATH_MAX],FN3[PATH_MAX],FN4[PATH_MAX],FN5[PATH_MAX]; ++ + #include + #define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);}) + +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -163,24 +163,6 @@ enum aelttype { /* array element type + #define STREF(type,x,i) (*((type *)(((char *)((x)->str.str_self))+(i)))) + #define STSET(type,x,i,val) do{SGC_TOUCH(x);STREF(type,x,i) = (val);} while(0) + +- +- +-enum smmode { /* stream mode */ +- smm_input, /* input */ +- smm_output, /* output */ +- smm_io, /* input-output */ +- smm_probe, /* probe */ +- smm_synonym, /* synonym */ +- smm_broadcast, /* broadcast */ +- smm_concatenated, /* concatenated */ +- smm_two_way, /* two way */ +- smm_echo, /* echo */ +- smm_string_input, /* string input */ +- smm_string_output, /* string output */ +- smm_user_defined, /* for user defined */ +- smm_socket /* Socket stream */ +-}; +- + /* for any stream that takes writec_char, directly (not two_way or echo) + ie. smm_output,smm_io, smm_string_output, smm_socket + */ +@@ -217,9 +199,9 @@ enum gcl_sm_flags { + gcl_sm_tcp_async, + gcl_sm_input, + gcl_sm_output, ++ gcl_sm_closed, + gcl_sm_had_error + +- + }; + + enum chattrib { /* character attribute */ +@@ -496,8 +478,11 @@ object make_si_sfun(); + Used by the C function to set optionals */ + + #define VFUN_NARGS fcall.argd ++#define RETURN4(x,y,z,w) do{/* object _x = (void *) x; */ \ ++ fcall.values[1]=y;fcall.values[2]=z;fcall.values[3]=w;fcall.nvalues=4; \ ++ return (x) ;} while(0) + #define RETURN2(x,y) do{/* object _x = (void *) x; */\ +- fcall.values[2]=y;fcall.nvalues=2; \ ++ fcall.values[1]=y;fcall.nvalues=2; \ + return (x) ;} while(0) + #define RETURN1(x) do{fcall.nvalues=1; return (x) ;} while(0) + #define RETURN0 do{fcall.nvalues=0; return Cnil ;} while(0) +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -88,7 +88,7 @@ + /* big.c:85:OF */ extern void zero_big (object x); /* (x) object x; */ + /* bind.c:74:OF */ extern void lambda_bind (object *arg_top); /* (arg_top) object *arg_top; */ + /* bind.c:564:OF */ extern void bind_var (object var, object val, object spp); /* (var, val, spp) object var; object val; object spp; */ +-/* bind.c:610:OF */ extern object find_special (object body, struct bind_temp *start, struct bind_temp *end); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ ++/* bind.c:610:OF */ extern object find_special (object body, struct bind_temp *start, struct bind_temp *end,object *s); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ + /* bind.c:670:OF */ extern object let_bind (object body, struct bind_temp *start, struct bind_temp *end); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ + /* bind.c:688:OF */ extern object letA_bind (object body, struct bind_temp *start, struct bind_temp *end); /* (body, start, end) object body; struct bind_temp *start; struct bind_temp *end; */ + /* bind.c:712:OF */ extern void parse_key (object *base, bool rest, bool allow_other_keys, register int n, ... ); +--- gcl-2.6.12.orig/h/type.h ++++ gcl-2.6.12/h/type.h +@@ -7,6 +7,7 @@ enum type { + t_shortfloat, + t_longfloat, + t_complex, ++ t_stream, + t_pathname, + t_string, + t_bitvector, +@@ -17,7 +18,6 @@ enum type { + t_character, + t_symbol, + t_package, +- t_stream, + t_random, + t_readtable, + t_cfun, +@@ -36,6 +36,23 @@ enum type { + }; + + ++enum smmode { /* stream mode */ ++ smm_input, /* input */ ++ smm_output, /* output */ ++ smm_io, /* input-output */ ++ smm_probe, /* probe */ ++ smm_file_synonym, /* synonym stream to file_stream */ ++ smm_synonym, /* synonym */ ++ smm_broadcast, /* broadcast */ ++ smm_concatenated, /* concatenated */ ++ smm_two_way, /* two way */ ++ smm_echo, /* echo */ ++ smm_string_input, /* string input */ ++ smm_string_output, /* string output */ ++ smm_user_defined, /* for user defined */ ++ smm_socket /* Socket stream */ ++}; ++ + #define Zcdr(a_) (*(object *)(a_))/* ((a_)->c.c_cdr) */ /*FIXME*/ + + #ifndef WIDE_CONS +@@ -82,7 +99,7 @@ enum type { + #else + #define TYPEWORD_TYPE_P(y_) (y_!=t_cons) + #endif +- ++ + /*Note preserve sgc flag here VVV*/ + #define set_type_of(x,y) ({object _x=(object)(x);enum type _y=(y);_x->d.f=0;\ + if (TYPEWORD_TYPE_P(_y)) {_x->d.e=1;_x->d.t=_y;_x->fw|=(fixnum)OBJNULL;}}) +@@ -113,6 +130,7 @@ enum type { + #define randomp(a_) SPP(a_,random) + #define characterp(a_) SPP(a_,character) + #define symbolp(a_) SPP(a_,symbol) ++#define pathnamep(a_) SPP(a_,pathname) + #define stringp(a_) SPP(a_,string) + #define fixnump(a_) SPP(a_,fixnum) + #define readtablep(a_) SPP(a_,readtable) +@@ -133,3 +151,6 @@ enum type { + || _tp == t_symbol;}) + #define pathname_string_symbol_streamp(a_) ({enum type _tp=type_of(a_); _tp==t_pathname || _tp == t_string\ + || _tp == t_symbol || _tp==t_stream;}) ++ ++#define pathname_designatorp(a_) ({object _a=(a_);enum type _tp=type_of(a_);\ ++ _tp==t_pathname||_tp==t_string||(_tp==t_stream && _a->sm.sm_mode>=smm_input && _a->sm.sm_mode<=smm_file_synonym);}) +--- gcl-2.6.12.orig/lsp/gcl_autoload.lsp ++++ gcl-2.6.12/lsp/gcl_autoload.lsp +@@ -410,10 +410,3 @@ Good luck! The GCL Development Team" + (setf (get 'with-open-file 'si:pretty-print-format) 1) + (setf (get 'with-open-stream 'si:pretty-print-format) 1) + (setf (get 'with-output-to-string 'si:pretty-print-format) 1) +- +- +-(in-package :si) +- +-(defvar *lib-directory* (namestring (truename "../"))) +- +-(import '(*lib-directory* *load-path* *system-directory*) :user) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -0,0 +1,67 @@ ++(in-package :si) ++ ++(defconstant +d-type-alist+ (d-type-list)) ++ ++(defun ?push (x tp) ++ (when (and x (eq tp :directory)) (vector-push-extend #\/ x)) ++ x) ++ ++(defun wreaddir (x s &optional y (ls (length s) lsp) &aux (y (if (rassoc y +d-type-alist+) y :unknown))) ++ (when lsp (setf (fill-pointer s) ls)) ++ (let ((r (readdir x (car (rassoc y +d-type-alist+)) s))) ++ (typecase r ++ (fixnum (wreaddir x (adjust-array s (+ 100 (ash (array-dimension s 0) 1))) y)) ++ (cons (let ((tp (cdr (assoc (cdr r) +d-type-alist+)))) (cons (?push (car r) tp) tp))) ++ (otherwise (?push r y))))) ++ ++(defun dot-dir-p (r l) (member-if (lambda (x) (string= x r :start2 l)) '("./" "../"))) ++ ++(defun vector-push-string (x s &optional (ss 0) (lx (length x)) &aux (ls (- (length s) ss))) ++ (let ((x (if (> ls (- (array-dimension x 0) lx)) (adjust-array x (+ ls (ash lx 1))) x))) ++ (setf (fill-pointer x) (+ lx ls)) ++ (replace x s :start1 lx :start2 ss))) ++ ++(defun walk-dir (s e f &optional (y :unknown) (d (opendir s)) (l (length s)) (le (length e)) ++ &aux (r (wreaddir d s y l))) ++ (cond (r (unless (dot-dir-p r l) (funcall f r (vector-push-string e r l le) l)) ++ (walk-dir s e f y d l le)) ++ ((setf (fill-pointer s) l (fill-pointer e) le) (closedir d)))) ++ ++(defun recurse-dir (x y f) ++ (funcall f x y) ++ (walk-dir x y (lambda (x y l) (declare (ignore l)) (recurse-dir x y f)) :directory)) ++ ++(defun make-frame (s &aux (l (length s))) ++ (replace (make-array l :element-type 'character :adjustable t :fill-pointer l) s)) ++ ++(defun expand-wild-directory (l f zz &optional (yy (make-frame zz))) ++ (let* ((x (member-if 'wild-dir-element-p l)) ++ (s (namestring (make-pathname :directory (ldiff l x)))) ++ (z (vector-push-string zz s)) ++ (l (length yy)) ++ (y (link-expand (vector-push-string yy s) l)) ++ (y (if (eq y yy) y (make-frame y)))) ++ (when (or (eq (stat z) :directory) (zerop (length z))) ++ (cond ((eq (car x) :wild-inferiors) (recurse-dir z y f)) ++ (x (walk-dir z y (lambda (q e l) ++ (declare (ignore l)) ++ (expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME ++ ((funcall f z y)))))) ++ ++(defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) ++ (c (unless (eq (car d) :absolute) (make-frame (concatenate 'string (getcwd) "/")))) ++ (lc (when c (length c))) ++ (filesp (or (pathname-name p) (pathname-type p))) ++ (v (compile-regexp (to-regexp p)))(*up-key* :back) r) ++ (expand-wild-directory d ++ (lambda (dir exp &aux (pexp (pathname (if c (vector-push-string c exp 0 lc) exp)))) ++ (if filesp ++ (walk-dir dir exp ++ (lambda (dir exp pos) ++ (declare (ignore exp)) ++ (when (pathname-match-p dir v) ++ (push (merge-pathnames (parse-namestring dir nil *default-pathname-defaults* :start pos) pexp nil) r))) ++ :file) ++ (when (pathname-match-p dir v) (push pexp r)))) ++ (make-frame (if c "./" ""))) ++ r) +--- gcl-2.6.12.orig/lsp/gcl_fpe.lsp ++++ gcl-2.6.12/lsp/gcl_fpe.lsp +@@ -60,7 +60,7 @@ + + + (defun rf (addr w) +- (ecase w (4 (*float addr)) (8 (*double addr)))) ++ (ecase w (4 (*float addr 0 nil nil)) (8 (*double addr 0 nil nil)))) + + (defun ref (addr p w &aux (i -1)) + (if p +@@ -71,7 +71,7 @@ + (f (eql #\F (aref z 0)))) + (ref addr (unless f (eql (aref z (- lz 2)) #\P)) (if (or f (eql (aref z (1- lz)) #\D)) 8 4))) + +-(defun reg-lookup (x) (*fixnum (+ (car *context*) (symbol-value x)))) ++(defun reg-lookup (x) (*fixnum (+ (car *context*) (symbol-value x)) 0 nil nil)) + + (defun st-lookup (x) (fld (+ (cadr *context*) (symbol-value x)))) + (defun xmm-lookup (x) (gref (+ (caddr *context*) (symbol-value x)))) +--- gcl-2.6.12.orig/lsp/gcl_fpe_test.lsp ++++ gcl-2.6.12/lsp/gcl_fpe_test.lsp +@@ -1,6 +1,6 @@ +-#.`(defun test-fpe (f a r &optional chk &aux cc (o (mapcan (lambda (x) (list x t)) (si::break-on-floating-point-exceptions)))) ++#.`(defun test-fpe (f a r &optional chk &aux cc (o (mapcan (lambda (x) (list x t)) (break-on-floating-point-exceptions)))) + (flet ((set-break (x) (when (keywordp r) +- (apply 'si::break-on-floating-point-exceptions (append (unless x o) (list r x)))))) ++ (apply 'break-on-floating-point-exceptions (append (unless x o) (list r x)))))) + (let* ((rr (handler-case (unwind-protect (progn (set-break t) (apply f a)) (set-break nil)) + ,@(mapcar (lambda (x &aux (x (car x))) `(,x (c) (setq cc c) ,(intern (symbol-name x) :keyword))) + (append si::+fe-list+ '((arithmetic-error)(error))))))) +--- gcl-2.6.12.orig/lsp/gcl_info.lsp ++++ gcl-2.6.12/lsp/gcl_info.lsp +@@ -8,28 +8,6 @@ + (,op (the fixnum ,x) (the fixnum ,y)))) + (defmacro fcr (x) `(load-time-value (compile-regexp ,x)))) + +-(eval-when (compile eval load) +-(defun sharp-u-reader (stream subchar arg) +- subchar arg +- (let ((tem (make-array 10 :element-type 'character :fill-pointer 0))) +- (or (eql (read-char stream) #\") +- (error "sharp-u-reader reader needs a \" right after it")) +- (loop +- (let ((ch (read-char stream))) +- (cond ((eql ch #\") (return tem)) +- ((eql ch #\\) +- (setq ch (read-char stream)) +- (setq ch (or (cdr (assoc ch '((#\n . #\newline) +- (#\t . #\tab) +- (#\r . #\return)))) +- ch)))) +- (vector-push-extend ch tem))) +- tem)) +- +-(set-dispatch-macro-character #\# #\u 'sharp-u-reader) +- +-) +- + (defconstant +crlu+ (compile-regexp #u"")) + (defconstant +crnp+ (compile-regexp #u"[ ]")) + +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -1,3 +1,4 @@ ++;; -*-Lisp-*- + ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa + + ;; This file is part of GNU Common Lisp, herein referred to as GCL +@@ -24,130 +25,229 @@ + + (in-package :si) + +-(proclaim '(optimize (safety 2) (space 3))) ++(defun concatenated-stream-streams (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream concatenated-stream) ++ (c-stream-object0 stream)) ++(defun broadcast-stream-streams (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream broadcast-stream) ++ (c-stream-object0 stream)) ++(defun two-way-stream-input-stream (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream two-way-stream) ++ (c-stream-object0 stream)) ++(defun echo-stream-input-stream (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream echo-stream) ++ (c-stream-object0 stream)) ++(defun two-way-stream-output-stream (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream two-way-stream) ++ (c-stream-object1 stream)) ++(defun echo-stream-output-stream (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream echo-stream) ++ (c-stream-object1 stream)) ++(defun synonym-stream-symbol (stream) ++ (declare (optimize (safety 2))) ++ (check-type stream synonym-stream) ++ (c-stream-object0 stream)) + ++(defun maybe-clear-input (&optional (x *standard-input*)) ++ (typecase x ++ (synonym-stream (maybe-clear-input (symbol-value (synonym-stream-symbol x)))) ++ (two-way-stream (maybe-clear-input (two-way-stream-input-stream x))) ++ (stream (when (terminal-input-stream-p x) (clear-input t))))) + + (defmacro with-open-stream ((var stream) . body) +- (multiple-value-bind (ds b) +- (find-declarations body) ++ (declare (optimize (safety 1))) ++ (multiple-value-bind (ds b) (find-declarations body) + `(let ((,var ,stream)) + ,@ds + (unwind-protect +- (progn ,@b) ++ (progn ,@b) + (close ,var))))) + +- + (defmacro with-input-from-string ((var string &key index start end) . body) +- (let ((x (sgen "X"))) +- (multiple-value-bind (ds b) +- (find-declarations body) +- `(let ((,var (make-string-input-stream ,string ,start ,end))) +- ,@ds +- (unwind-protect +- ,(let ((f `(progn ,@b))) +- (if index +- `(let ((,x (multiple-value-list ,f))) (setf ,index (get-string-input-stream-index ,var)) (values-list ,x)) +- f)) +- (close ,var)))))) ++ (declare (optimize (safety 1))) ++ (multiple-value-bind (ds b) (find-declarations body) ++ `(let ((,var (make-string-input-stream ,string ,start ,end))) ++ ,@ds ++ (unwind-protect ++ (multiple-value-prog1 ++ (progn ,@b) ++ ,@(when index `((setf ,index (get-string-input-stream-index ,var))))) ++ (close ,var))))) + + (defmacro with-output-to-string ((var &optional string &key element-type) . body) +- (let ((s (sgen "STRING"))(bl (sgen "BLOCK"))(e (sgen "ELEMENT-TYPE"))(x (sgen "X"))) +- (multiple-value-bind (ds b) +- (find-declarations body) +- `(let* ((,s ,string)(,e ,element-type) +- (,var (if ,s (make-string-output-stream-from-string ,s) (make-string-output-stream :element-type ,e)))) ++ (declare (optimize (safety 1))) ++ (let ((s (sgen "STRING"))) ++ (multiple-value-bind (ds b) (find-declarations body) ++ `(let* ((,s ,string) ++ (,var (if ,s (make-string-output-stream-from-string ,s) (make-string-output-stream :element-type ,element-type)))) + ,@ds + (unwind-protect +- (let ((,x (multiple-value-list (progn ,@b)))) (if ,s (values-list ,x) (get-output-stream-string ,var))) ++ (block nil ++ (multiple-value-prog1 ++ (progn ,@b) ++ (unless ,s (return (get-output-stream-string ,var))))) + (close ,var)))))) + + +-(defun read-from-string (string +- &optional (eof-error-p t) eof-value +- &key (start 0) (end (length string)) +- preserve-whitespace) +- (let ((stream (make-string-input-stream string start end))) +- (if preserve-whitespace +- (values (read-preserving-whitespace stream eof-error-p eof-value) +- (si:get-string-input-stream-index stream)) +- (values (read stream eof-error-p eof-value) +- (si:get-string-input-stream-index stream))))) +- ++(defun read-from-string (string &optional (eof-error-p t) eof-value ++ &key (start 0) end preserve-whitespace) ++ (declare (optimize (safety 1))) ++ (check-type string string) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ (let ((stream (make-string-input-stream string start (or end (length string))))) ++ (values (if preserve-whitespace ++ (read-preserving-whitespace stream eof-error-p eof-value) ++ (read stream eof-error-p eof-value)) ++ (get-string-input-stream-index stream)))) ++ ++;; (defun write (x &key stream ++;; (array *print-array*) ++;; (base *print-base*) ++;; (case *print-case*) ++;; (circle *print-circle*) ++;; (escape *print-escape*) ++;; (gensym *print-gensym*) ++;; (length *print-length*) ++;; (level *print-level*) ++;; (lines *print-lines*) ++;; (miser-width *print-miser-width*) ++;; (pprint-dispatch *print-pprint-dispatch*) ++;; (pretty *print-pretty*) ++;; (radix *print-radix*) ++;; (readably *print-readably*) ++;; (right-margin *print-right-margin*)) ++;; (write-int x stream array base case circle escape gensym ++;; length level lines miser-width pprint-dispatch ++;; pretty radix readably right-margin)) + + (defun write-to-string (object &rest rest +- &key escape radix base +- circle pretty level length +- case gensym array +- &aux (stream (make-string-output-stream))) +- (declare (ignore escape radix base +- circle pretty level length +- case gensym array)) ++ &key (escape *print-escape*)(radix *print-radix*)(base *print-base*) ++ (circle *print-circle*)(pretty *print-pretty*)(level *print-level*) ++ (length *print-length*)(case *print-case*)(gensym *print-gensym*) ++ (array *print-array*)(lines *print-lines*)(miser-width *print-miser-width*) ++ (pprint-dispatch *print-pprint-dispatch*)(readably *print-readably*) ++ (right-margin *print-right-margin*) ++ &aux (stream (make-string-output-stream)) ++ (*print-escape* escape)(*print-radix* radix)(*print-base* base) ++ (*print-circle* circle)(*print-pretty* pretty)(*print-level* level) ++ (*print-length* length)(*print-case* case)(*print-gensym* gensym) ++ (*print-array* array)(*print-lines* lines)(*print-miser-width* miser-width) ++ (*print-pprint-dispatch* pprint-dispatch)(*print-readably* readably ) ++ (*print-right-margin* right-margin)) ++ (declare (optimize (safety 1))(dynamic-extent rest)) + (apply #'write object :stream stream rest) + (get-output-stream-string stream)) + ++(defun prin1-to-string (object &aux (stream (make-string-output-stream))) ++ (declare (optimize (safety 1))) ++ (prin1 object stream) ++ (get-output-stream-string stream)) + +-(defun prin1-to-string (object +- &aux (stream (make-string-output-stream))) +- (prin1 object stream) +- (get-output-stream-string stream)) +- +- +-(defun princ-to-string (object +- &aux (stream (make-string-output-stream))) ++(defun princ-to-string (object &aux (stream (make-string-output-stream))) ++ (declare (optimize (safety 1))) + (princ object stream) + (get-output-stream-string stream)) + ++;; (defun file-string-length (ostream object) ++;; (declare (optimize (safety 2))) ++;; (let ((ostream (if (typep ostream 'broadcast-stream) ++;; (car (last (broadcast-stream-streams ostream))) ++;; ostream))) ++;; (cond ((not ostream) 1) ++;; ((subtypep1 (stream-element-type ostream) 'character) ++;; (length (let ((*print-escape* nil)) (write-to-string object))))))) ++ ++;; (defmacro with-temp-file ((s pn) (tmp ext) &rest body) ++;; (multiple-value-bind ++;; (doc decls ctps body) ++;; (parse-body-header body) ++;; (declare (ignore doc)) ++;; `(let* ((,s (temp-stream ,tmp ,ext)) ++;; (,pn (stream-object1 ,s))) ++;; ,@decls ++;; ,@ctps ++;; (unwind-protect (progn ,@body) (progn (close ,s) (delete-file ,s)))))) ++ + + (defmacro with-open-file ((stream . filespec) . body) +- (multiple-value-bind (ds b) +- (find-declarations body) ++ (declare (optimize (safety 1))) ++ (multiple-value-bind (ds b) (find-declarations body) + `(let ((,stream (open ,@filespec))) + ,@ds + (unwind-protect +- (progn ,@b) +- (if ,stream (close ,stream)))))) ++ (progn ,@b) ++ (when ,stream (close ,stream)))))) + ++;; (defun pprint-dispatch (obj &optional (table *print-pprint-dispatch*)) ++;; (declare (optimize (safety 2))) ++;; (let ((fun (si:get-pprint-dispatch obj table))) ++;; (if fun (values fun t) (values 'si:default-pprint-object nil)))) ++ ++;; (setq *print-pprint-dispatch* '(pprint-dispatch . nil)) ++ ++;; (defun set-pprint-dispatch (type-spec function &optional ++;; (priority 0) ++;; (table *print-pprint-dispatch*)) ++;; (declare (optimize (safety 2))) ++;; (unless (typep priority 'real) ++;; (error 'type-error :datum priority :expected-type 'real)) ++;; (let ((a (assoc type-spec (cdr table) :test 'equal))) ++;; (if a (setf (cdr a) (list function priority)) ++;; (rplacd (last table) `((,type-spec ,function ,priority))))) ++;; nil) ++ ++;; (defun copy-pprint-dispatch (&optional table) ++;; (declare (optimize (safety 2))) ++;; (unless table ++;; (setq table *print-pprint-dispatch*)) ++;; (unless (and (eq (type-of table) 'cons) ++;; (eq (car table) 'pprint-dispatch)) ++;; (error 'type-error :datum table :expected-type 'pprint-dispatch)) ++;; (copy-seq table )) + +-(defun y-or-n-p (&optional string &rest args) +- (do ((reply)) +- (nil) +- (when string (format *query-io* "~&~? (Y or N) " string args)) +- (setq reply (read *query-io*)) +- (cond ((string-equal (symbol-name reply) "Y") +- (return-from y-or-n-p t)) +- ((string-equal (symbol-name reply) "N") +- (return-from y-or-n-p nil))))) + ++(defun y-or-n-p (&optional string &rest args) ++ (declare (optimize (safety 1))) ++ (when string (format *query-io* "~&~? (Y or N) " string args)) ++ (let ((reply (symbol-name (read *query-io*)))) ++ (cond ((string-equal reply "Y") t) ++ ((string-equal reply "N") nil) ++ ((apply 'y-or-n-p string args))))) + + (defun yes-or-no-p (&optional string &rest args) +- (do ((reply)) +- (nil) +- (when string (format *query-io* "~&~? (Yes or No) " string args)) +- (setq reply (read *query-io*)) +- (cond ((string-equal (symbol-name reply) "YES") +- (return-from yes-or-no-p t)) +- ((string-equal (symbol-name reply) "NO") +- (return-from yes-or-no-p nil))))) +- ++ (declare (optimize (safety 1))) ++ (when string (format *query-io* "~&~? (Yes or No) " string args)) ++ (let ((reply (symbol-name (read *query-io*)))) ++ (cond ((string-equal reply "YES") t) ++ ((string-equal reply "NO") nil) ++ ((apply 'yes-or-no-p string args))))) + + (defun sharp-a-reader (stream subchar arg) + (declare (ignore subchar)) + (let ((initial-contents (read stream nil nil t))) +- (if *read-suppress* +- nil +- (do ((i 0 (1+ i)) +- (d nil (cons (length ic) d)) +- (ic initial-contents (if (zerop (length ic)) ic (elt ic 0)))) +- ((>= i arg) +- (make-array (nreverse d) +- :initial-contents initial-contents)))))) ++ (unless *read-suppress* ++ (do ((i 0 (1+ i)) ++ (d nil (cons (length ic) d)) ++ (ic initial-contents (if (zerop (length ic)) ic (elt ic 0)))) ++ ((>= i arg) (make-array (nreverse d) :initial-contents initial-contents)))))) + + (set-dispatch-macro-character #\# #\a 'sharp-a-reader) ++(set-dispatch-macro-character #\# #\a 'sharp-a-reader (standard-readtable)) + (set-dispatch-macro-character #\# #\A 'sharp-a-reader) ++(set-dispatch-macro-character #\# #\A 'sharp-a-reader (standard-readtable)) + + ;; defined in defstruct.lsp + (set-dispatch-macro-character #\# #\s 'sharp-s-reader) ++(set-dispatch-macro-character #\# #\s 'sharp-s-reader (standard-readtable)) + (set-dispatch-macro-character #\# #\S 'sharp-s-reader) ++(set-dispatch-macro-character #\# #\S 'sharp-s-reader (standard-readtable)) + + (defvar *dribble-stream* nil) + (defvar *dribble-io* nil) +@@ -155,6 +255,7 @@ + (defvar *dribble-saved-terminal-io* nil) + + (defun dribble (&optional (pathname "DRIBBLE.LOG" psp) (f :supersede)) ++ (declare (optimize (safety 1))) + (cond ((not psp) + (when (null *dribble-stream*) (error "Not in dribble.")) + (if (eq *dribble-io* *terminal-io*) +@@ -183,73 +284,18 @@ + (format t "~&Starts dribbling to ~A (~d/~d/~d, ~d:~d:~d)." + namestring year month day hour min sec)))))) + +-(defconstant char-length 8) +- +-(defun get-byte-stream-nchars (s) +- (check-type s stream) +- (let* ((tp (stream-element-type s)) +- (tp (if (consp tp) (cadr tp) char-length)) +- (nc (ceiling tp char-length))) +- nc)) +- +-(defun write-byte (j s) +- (declare (optimize (safety 1))) +- (let ((nc (get-byte-stream-nchars s)) +- (ff (1- (expt 2 char-length)))) +- (do ((k 0 (1+ k))(i j (ash i (- char-length)))) ((>= k nc) j) +- (write-char (code-char (logand i ff)) s)))) +- +-(defun read-byte (s &optional (eof-error-p t) eof-value) +- (declare (optimize (safety 1))) +- (let ((nc (get-byte-stream-nchars s))) +- (do ((j 0 (1+ j)) +- (i 0 (logior i +- (ash (char-code (let ((ch (read-char s eof-error-p eof-value))) +- (if (and (not eof-error-p) (eq ch eof-value)) +- (return-from read-byte ch) +- ch))) (* j char-length))))) +- ((>= j nc) i)))) +- +- +-(defun read-sequence (seq strm &key (start 0) end) +- (declare (optimize (safety 1))) +- (check-type seq sequence) +- (check-type start (integer 0)) +- (check-type end (or null (integer 0))) +- (let* ((start (min start array-dimension-limit)) +- (end (if end (min end array-dimension-limit) (length seq))) +- (l (listp seq)) +- (seq (if (and l (> start 0)) (nthcdr start seq) seq)) +- (tp (subtypep (stream-element-type strm) 'character))) +- (do ((i start (1+ i))(seq seq (if l (cdr seq) seq))) +- ((or (>= i end) (when l (endp seq))) i) +- (declare (fixnum i)) +- (let ((el (if tp (read-char strm nil 'eof) (read-byte strm nil 'eof)))) +- (when (eq el 'eof) (return i)) +- (if l (setf (car seq) el) (setf (aref seq i) el)))))) +- ++;; (defmacro formatter ( control-string ) ++;; (declare (optimize (safety 2))) ++;; `(progn ++;; (lambda (*standard-output* &rest arguments) ++;; (let ((*format-unused-args* nil)) ++;; (apply 'format t ,control-string arguments) ++;; *format-unused-args*)))) + +-(defun write-sequence (seq strm &key (start 0) end) ++(defun stream-external-format (s) + (declare (optimize (safety 1))) +- (check-type seq sequence) +- (check-type start (integer 0)) +- (check-type end (or null (integer 0))) +- (let* ((start (min start array-dimension-limit)) +- (end (if end (min end array-dimension-limit) (length seq))) +- (l (listp seq)) +- (tp (subtypep (stream-element-type strm) 'character))) +- (do ((i start (1+ i)) +- (seq (if (and l (> start 0)) (nthcdr start seq) seq) (if l (cdr seq) seq))) +- ((or (>= i end) (when l (endp seq)))) +- (declare (fixnum i)) +- (let ((el (if l (car seq) (aref seq i)))) +- (if tp (write-char el strm) (write-byte el strm)))) +- seq)) +- +-(defmacro with-compilation-unit (opt &rest body) +- (declare (optimize (safety 2))) +- (declare (ignore opt)) +- `(progn ,@body)) ++ (check-type s stream) ++ :default) + + (defvar *print-lines* nil) + (defvar *print-miser-width* nil) +@@ -257,7 +303,7 @@ + (defvar *print-right-margin* nil) + + (defmacro with-standard-io-syntax (&body body) +- (declare (optimize (safety 2))) ++ (declare (optimize (safety 1))) + `(let* ((*package* (find-package :cl-user)) + (*print-array* t) + (*print-base* 10) +@@ -269,7 +315,7 @@ + (*print-level* nil) + (*print-lines* nil) + (*print-miser-width* nil) +- (*print-pprint-dispatch* *print-pprint-dispatch*) ++ (*print-pprint-dispatch* *print-pprint-dispatch*);FIXME + (*print-pretty* nil) + (*print-radix* nil) + (*print-readably* t) +@@ -278,37 +324,163 @@ + (*read-default-float-format* 'single-float) + (*read-eval* t) + (*read-suppress* nil) +- (*readtable* (copy-readtable (si::standard-readtable))));FIXME copy? ++ (*readtable* (copy-readtable (standard-readtable)))) + ,@body)) + ++;; (defmacro print-unreadable-object ++;; ((object stream &key type identity) &body body) ++;; (declare (optimize (safety 2))) ++;; (let ((q `(princ " " ,stream))) ++;; `(if *print-readably* ++;; (error 'print-not-readable :object ,object) ++;; (progn ++;; (princ "#<" ,stream) ++;; ,@(when type `((prin1 (type-of ,object) ,stream) ,q)) ++;; ,@body ++;; ,@(when identity ++;; (let ((z `(princ (address ,object) ,stream))) ++;; (if (and (not body) type) (list z) (list q z)))) ++;; (princ ">" ,stream) ++;; nil)))) ++ ++;; (defmacro with-compile-file-syntax (&body body) ++;; `(let ((*print-radix* nil) ++;; (*print-base* 10) ++;; (*print-circle* t) ++;; (*print-pretty* nil) ++;; (*print-level* nil) ++;; (*print-length* nil) ++;; (*print-case* :downcase) ++;; (*print-gensym* t) ++;; (*print-array* t) ++;; (*print-package* t) ++;; (*print-structure* t)) ++;; ,@body)) ++ ++(defmacro with-compilation-unit (opt &rest body) ++ (declare (optimize (safety 1))) ++ (declare (ignore opt)) ++ `(progn ,@body)) ++ ++(defconstant char-length 8) ++ ++(defun get-byte-stream-nchars (s) ++ (let* ((tp (stream-element-type s))) ++ (ceiling (if (consp tp) (cadr tp) char-length) char-length))) ++ ++;; (defun parse-integer (s &key start end (radix 10) junk-allowed) ++;; (declare (optimize (safety 1))) ++;; (parse-integer-int s start end radix junk-allowed)) ++ ++(defun write-byte (j s &aux (i j)) ++ (declare (optimize (safety 1))) ++ (check-type j integer) ++ (check-type s stream) ++ (dotimes (k (get-byte-stream-nchars s) j) ++ (write-char (code-char (logand i #.(1- (ash 1 char-length)))) s) ++ (setq i (ash i #.(- char-length))))) ++ ++ ++(defun read-byte (s &optional (eof-error-p t) eof-value &aux (i 0)) ++ (declare (optimize (safety 1))) ++ (check-type s stream) ++ (dotimes (k (get-byte-stream-nchars s) i) ++ (setq i (logior i (ash (let ((ch (read-char s eof-error-p eof-value))) ++ (if (eq ch eof-value) (return ch) (char-code ch))) ++ (* k char-length)))))) ++ ++ ++(defun read-sequence (seq strm &rest r &key (start 0) end ++ &aux (l (listp seq))(seqp (when l (nthcdr start seq))) ++ (cp (eq (stream-element-type strm) 'character))) ++ (declare (optimize (safety 1))(dynamic-extent r)) ++ (check-type seq sequence) ++ (check-type strm stream) ++ (check-type start (integer 0)) ++ (check-type end (or null (integer 0))) ++ (apply 'reduce (lambda (y x &aux (z (if cp (read-char strm nil 'eof) (read-byte strm nil 'eof)))) ++ (declare (seqind y)(ignorable x)) ++ (when (eq z 'eof) (return-from read-sequence y)) ++ (if l (setf (car seqp) z seqp (cdr seqp)) (setf (aref seq y) z)) ++ (1+ y)) seq :initial-value start r)) ++ ++ ++(defun write-sequence (seq strm &rest r &key (start 0) end ++ &aux (l (listp seq))(cp (eq (stream-element-type strm) 'character))) ++ (declare (optimize (safety 1))(dynamic-extent r)) ++ (check-type seq sequence) ++ (check-type strm stream) ++ (check-type start (integer 0)) ++ (check-type end (or null (integer 0))) ++ (apply 'reduce (lambda (y x) ++ (declare (seqind y)) ++ (if cp (write-char x strm) (write-byte x strm)) ++ (1+ y)) seq :initial-value start r) ++ seq) ++ ++(defun restrict-stream-element-type (tp) ++ (cond ((or (member tp '(character :default)) (subtypep tp 'character)) 'character) ++ ((subtypep tp 'integer) ++ (let* ((ntp (car (expand-ranges (normalize-type tp)))) ++ (min (or (cadr ntp) '*))(max (or (caddr ntp) '*)) ++ (s (if (or (eq min '*) (< min 0)) 'signed-byte 'unsigned-byte)) ++ (lim (unless (or (eq min '*) (eq max '*)) (max (integer-length min) (integer-length max)))) ++ (lim (if (and lim (eq s 'signed-byte)) (1+ lim) lim))) ++ (if lim `(,s ,lim) s))) ++ ((check-type tp (member character integer))))) ++ ++(defun open (f &key (direction :input) ++ (element-type 'character) ++ (if-exists nil iesp) ++ (if-does-not-exist nil idnesp) ++ (external-format :default) &aux (pf (pathname f))) ++ (declare (optimize (safety 1))) ++ (check-type f pathname-designator) ++ (when (wild-pathname-p pf) ++ (error 'file-error :pathname pf :format-control "Pathname is wild.")) ++ (let* ((s (open-int (namestring (translate-logical-pathname pf)) direction ++ (restrict-stream-element-type element-type) ++ if-exists iesp if-does-not-exist idnesp external-format))) ++ (when (typep s 'stream) (c-set-stream-object1 s pf) s))) ++ ++(defun load-pathname (p print if-does-not-exist external-format ++ &aux (pp (merge-pathnames p)) ++ (epp (reduce (lambda (y x) (or y (probe-file (translate-pathname x "" p)))) ++ '(#P".o" #P".lsp" #P".lisp" #P"") :initial-value nil)));FIXME newest? ++ (if epp ++ (let* ((*load-pathname* pp)(*load-truename* epp)) ++ (with-open-file ++ (s epp :external-format external-format) ++ (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xfe #xff #x4c))) ++ (load-fasl s print) ++ (let ((*standard-input* s)) (load-stream s print))))) ++ (when if-does-not-exist ++ (error 'file-error :pathname pp :format-control "File does not exist.")))) ++ ++(defun load (p &key (verbose *load-verbose*) (print *load-print*) (if-does-not-exist :error) ++ (external-format :default) &aux (*readtable* *readtable*)(*package* *package*)) ++ (declare (optimize (safety 1))) ++ (check-type p (or stream pathname-designator)) ++ (when verbose (format t ";; Loading ~s~%" p)) ++ (prog1 ++ (typecase p ++ (pathname-designator (load-pathname (pathname p) print if-does-not-exist external-format)) ++ (stream (load-stream p print))) ++ (when verbose (format t ";; Finished loading ~s~%" p)))) ++ + (defun ensure-directories-exist (ps &key verbose &aux created) ++ (declare (optimize (safety 1))) ++ (check-type ps pathname-designator) + (when (wild-pathname-p ps) + (error 'file-error :pathname ps :format-control "Pathname is wild")) +- (labels ((d (x y &aux (z (ldiff x y)) (p (make-pathname :directory z))) ++ (labels ((d (x y &aux (z (ldiff x y)) (n (namestring (make-pathname :directory z)))) + (when (when z (stringp (car (last z)))) +- (unless (eq :directory (car (stat p))) +- (mkdir (namestring p)) ++ (unless (eq :directory (stat n)) ++ (mkdir n) + (setq created t) +- (when verbose (format *standard-output* "Creating directory ~s~%" p)))) ++ (when verbose (format *standard-output* "Creating directory ~s~%" n)))) + (when y (d x (cdr y))))) + (let ((pd (pathname-directory ps))) + (d pd (cdr pd))) + (values ps created))) + +-#.(let ((g '(:host :device :directory :name :type :version))) +- `(defun wild-pathname-p (pd &optional f &aux (p (pathname pd))) +- (declare (optimize (safety 1))) +- (check-type f (or null (member ,@g))) +- (labels ((w-f (x) +- (case x +- ,@(mapcar (lambda (x &aux (f (intern (string-concatenate "PATHNAME-" (string-upcase x))))) +- `(,x ,(if (eq x :directory) `(when (member :wild (,f p)) t) `(eq :wild (,f p))))) g)))) +- (if f +- (w-f f) +- (reduce (lambda (z x) (or z (w-f x))) ',g :initial-value nil))))) +- +-(defun maybe-clear-input (&optional (x *standard-input*)) +- (cond ((not (typep x 'stream)) nil) +- ((typep x 'synonym-stream) (maybe-clear-input (symbol-value (synonym-stream-symbol x)))) +- ((typep x 'two-way-stream) (maybe-clear-input (two-way-stream-input-stream x))) +- ((terminal-input-stream-p x) (clear-input t)))) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_logical_pathname_translations.lsp +@@ -0,0 +1,28 @@ ++(in-package :si) ++ ++(defvar *pathname-logical* nil) ++ ++(defun setf-logical-pathname-translations (v k) ++ (declare (optimize (safety 1))) ++ (check-type v list) ++ (check-type k string) ++ (setf (cdr (or (assoc k *pathname-logical* :test 'string-equal) (car (push (cons k t) *pathname-logical*)))) ;(cons k nil) ++ (mapcar (lambda (x) (list (parse-namestring (car x) k) (parse-namestring (cadr x)))) v))) ++ ++(defsetf logical-pathname-translations (x) (y) `(setf-logical-pathname-translations ,y ,x)) ++(remprop 'logical-pathname-translations 'si::setf-update-fn) ++ ++(defun logical-pathname-translations (k) ++ (declare (optimize (safety 1))) ++ (check-type k string) ++ (cdr (assoc k *pathname-logical* :test 'string-equal))) ++ ++ ++(defun load-logical-pathname-translations (k) ++ (declare (optimize (safety 1))) ++ (unless (logical-pathname-translations k) ++ (error "No translations found for ~s" k))) ++ ++(defun logical-pathname-host-p (host) ++ (when host ++ (logical-pathname-translations host))) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_make_pathname.lsp +@@ -0,0 +1,155 @@ ++(in-package :si) ++ ++;; (defun pathnamep (x) ++;; (declare (optimize (safety 1))) ++;; (when (typep x 'pathname) t)) ++ ++(defun msub (a x) (if a (msub (cdr a) (substitute (caar a) (cdar a) x)) x)) ++ ++(defvar *glob-to-regexp-alist* (list (cons #v"{[^}]*}" (lambda (x) (msub '((#\| . #\,)(#\( . #\{)(#\) . #\})) x))) ++ (cons #v"\\[[^\\]*\\]" (lambda (x) ++ (concatenate 'string "(" ++ (substitute #\^ #\! (subseq x 0 2)) ++ (subseq x 2) ")"))) ++ (cons #v"\\*" (lambda (x) "([^/.]*)")) ++ (cons #v"\\?" (lambda (x) "([^/.])")) ++ (cons #v"\\." (lambda (x) "\\.")))) ++ ++(defun mglist (x &optional (b 0)) ++ (let* ((y (mapcan (lambda (z &aux (w (string-match (car z) x b))) ++ (unless (eql w -1) ++ (list (list w (match-end 0) z)))) ++ *glob-to-regexp-alist*)) ++ (z (when y (reduce (lambda (y x) (if (< (car x) (car y)) x y)) y)))) ++ (when z ++ (cons z (mglist x (cadr z)))))) ++ ++(defun mgsub (x &optional (l (mglist x)) (b 0) &aux (w (pop l))) ++ (if w ++ (concatenate 'string ++ (subseq x b (car w)) ++ (funcall (cdaddr w) (subseq x (car w) (cadr w))) ++ (mgsub x l (cadr w))) ++ (subseq x b))) ++ ++ ++(defun elsub (el x rp lp &aux (y x) (pref (pop y))(dflt (pop y))(post (pop y))) ++; (destructuring-bind (pref dflt post &rest y) x ++ (etypecase el ++ (string (let ((x (list pref el post))) (unless (zerop (length dflt)) (if rp (mapcar 'mgsub x) x)))) ++ (integer (elsub (write-to-string el) x rp lp)) ++ ((eql :wild-inferiors) (if rp (list "(" dflt "*)") (elsub "**" x rp lp))) ++ ((eql :wild) (if rp (list dflt) (elsub "*" x rp lp))) ++ ((eql :newest) (elsub (if rp "(newest|NEWEST)" "NEWEST") x rp lp)) ++ ((member :up :back) (elsub ".." x rp lp)) ++ ((member nil :unspecific) (when rp (list dflt))) ++ (cons (cons ++ (if (eq (car el) :absolute) (if lp "" "/") (if lp ";" "")) ++ (mapcan (lambda (z) (elsub z y rp lp)) (cdr el))))) ++; ) ++) ++ ++(defconstant +physical-pathname-defaults+ '(("" "" "") ++ ("" "" "") ++ ("" "(/?([^/]+/)*)" "" "" "([^/]+/)" "/") ++ ("" "([^/.]*)" "") ++ ("." "(\\.[^/]*)?" "") ++ ("" "" ""))) ++(defconstant +logical-pathname-defaults+ '(("" "([-0-9A-Z]+:)?" ":") ++ ("" "" "") ++ ("" "(;?((\\*?([-0-9A-Z]+\\*?)+|\\*|\\*\\*);)*)" "" "" "((\\*?([-0-9A-Z]+\\*?)+|\\*);)" ";") ++ ("" "(\\*?([-0-9A-Z]+\\*?)+|\\*)?" "") ++ ("." "(\\.(\\*?([-0-9A-Z]+\\*?)+|\\*))?" "") ++ ("." "(\\.([1-9][0-9]*|newest|NEWEST|\\*))?" ""))) ++ ++(defun to-regexp-or-namestring (x rp lp) ++ (apply 'concatenate 'string ++ (mapcan (lambda (x y) (elsub x y rp lp)) ++ x (if lp +logical-pathname-defaults+ +physical-pathname-defaults+)))) ++ ++(defun directory-list-check (l) ++ (when (listp l) ++ (when (member (car l) '(:absolute :relative)) ++ (mapl (lambda (x &aux (c (car x))(d (cadr x))) ++ (when (and (member d '(:up :back)) (member c '(:absolute :wild-inferiors))) ++ (return-from directory-list-check nil))) l)))) ++ ++(defun canonicalize-pathname-directory (l) ++ (cond ((eq l :wild) (canonicalize-pathname-directory '(:absolute :wild-inferiors))) ++ ((stringp l) (canonicalize-pathname-directory (list :absolute l))) ++ ((mapl (lambda (x &aux (c (car x))) ++ (when (and (or (stringp c) (eq c :wild)) (eq (cadr x) :back)) ++ (return-from canonicalize-pathname-directory ++ (canonicalize-pathname-directory (nconc (ldiff l x) (cddr x)))))) l)))) ++ ++(defvar *default-pathname-defaults* (init-pathname nil nil nil nil nil nil "")) ++(declaim (type pathname *default-pathname-defaults*)) ++ ++(defun toggle-case (x) ++ (cond ((symbolp x) x) ++ ((listp x) (mapcar 'toggle-case x)) ++ ((find-if 'upper-case-p x) (if (find-if 'lower-case-p x) x (string-downcase x))) ++ ((find-if 'lower-case-p x) (string-upcase x)) ++ (x))) ++ ++(defun logical-pathname (spec &aux (p (pathname spec))) ++ (declare (optimize (safety 1))) ++ (check-type spec pathname-designator) ++ (check-type p logical-pathname) ++ p) ++ ++(eval-when (compile eval) ++ (defun strsym (p &rest r) ++ (declare (:dynamic-extent r)) ++ (intern (apply 'concatenate 'string (mapcar 'string-upcase r)) p))) ++ ++#.`(defun make-pathname (&key (host nil hostp) (device nil devicep) (directory nil directoryp) ++ (name nil namep) (type nil typep) (version nil versionp) ++ defaults (case :local) namestring &aux defaulted (def (when defaults (pathname defaults)))) ++ (declare (optimize (safety 1))) ++ (check-type host (or (member nil :unspecific) string)) ++ (check-type device (member nil :unspecific)) ++ (check-type directory (or (member nil :unspecific :wild) string list)) ++ (check-type name (or string (member nil :unspecific :wild))) ++ (check-type type (or string (member nil :unspecific :wild))) ++ (check-type version (or (integer 1) (member nil :unspecific :wild :newest))) ++ (check-type defaults (or null pathname-designator)) ++ (check-type case (member :common :local)) ++ ,(flet ((def? (k) `(let* (,@(when (eq k 'host) `((def (or def *default-pathname-defaults*)))) ++ (nk (if ,(strsym :si k "P") ,k (progn (setq defaulted t) (when def (,(strsym :si "C-PATHNAME-" k) def))))) ++ (nk (if (eq case :local) nk (progn (setq defaulted t) (toggle-case nk))))) ++ nk))) ++ `(let* ((h ,(def? 'host)) ++ (h (let ((h1 (when (logical-pathname-host-p h) h))) (unless (eq h h1) (setq defaulted t)) h1)) ++ (dev ,(def? 'device)) ++ (d ,(def? 'directory)) ++ (d (let ((d1 (canonicalize-pathname-directory d))) (unless (eq d d1) (setq defaulted t)) d1)) ++ (n ,(def? 'name)) ++ (typ ,(def? 'type)) ++ (v ,(def? 'version)) ++ (p (init-pathname h dev d n typ v ++ (or (unless defaulted namestring) (to-regexp-or-namestring (list h dev d n typ v) nil h))))) ++ (when h (c-set-t-tt p 1)) ++ (unless (eq d (directory-list-check d)) ++ (error 'file-error :pathname p :format-control "Bad directory list")) ++ p))) ++ ++(macrolet ((pn-accessor (k &aux (f (strsym :si "PATHNAME-" k)) (c (strsym :si "C-PATHNAME-" k))) ++ `(defun ,f (p &key (case :local) &aux (pn (pathname p))) ++ (declare (optimize (safety 1))) ++ (check-type p pathname-designator) ++ (let ((x (,c pn))) (if (eq case :local) x (toggle-case x)))))) ++ (pn-accessor host) ++ (pn-accessor device) ++ (pn-accessor directory) ++ (pn-accessor name) ++ (pn-accessor type) ++ (pn-accessor version)) ++ ++(defconstant +pathname-keys+ '(:host :device :directory :name :type :version)) ++ ++#.`(defun mlp (p) ++ (list ,@(mapcar (lambda (x) `(,(strsym :si "C-PATHNAME-" x) p)) +pathname-keys+))) ++ ++(defun pnl1 (x) (list* (pop x) (pop x) (append (pop x) x))) ++(defun lnp (x) (list* (pop x) (pop x) (let ((q (last x 3))) (cons (ldiff x q) q)))) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_merge_pathnames.lsp +@@ -0,0 +1,18 @@ ++(in-package :si) ++ ++(defun merge-pathnames (p &optional (def *default-pathname-defaults*) (def-v :newest) ++ &aux dflt (pn (pathname p))(def-pn (pathname def))) ++ (declare (optimize (safety 1))) ++ (check-type p pathname-designator) ++ (check-type def pathname-designator) ++ (check-type def-v (or null (eql :newest) seqind)) ++ (labels ((def (x) (when x (setq dflt t) x))) ++ (make-pathname ++ :host (or (pathname-host pn) (def (pathname-host def-pn))) ++ :device (or (pathname-device pn) (def (pathname-device def-pn))) ++ :directory (let ((d (pathname-directory pn))(defd (pathname-directory def-pn))) ++ (or (def (when (and defd (eq (car d) :relative)) (append defd (cdr d)))) d (def defd))) ++ :name (or (pathname-name pn) (def (pathname-name def-pn))) ++ :type (or (pathname-type pn) (def (pathname-type def-pn))) ++ :version (or (pathname-version pn) (def (unless (pathname-name pn) (pathname-version def-pn))) (def def-v)) ++ :version (unless dflt (return-from merge-pathnames pn))))) +--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp ++++ gcl-2.6.12/lsp/gcl_mislib.lsp +@@ -114,13 +114,15 @@ + (* (+ h tz) 3600) (* min 60) sec)) + + (defun compile-file-pathname (pathname) +-(make-pathname :defaults pathname :type "o")) ++ (make-pathname :defaults pathname :type "o")) ++ + (defun constantly (x) +-#'(lambda (&rest args) ++ (lambda (&rest args) + (declare (ignore args) (:dynamic-extent args)) +-x)) ++ x)) ++ + (defun complement (fn) +-#'(lambda (&rest args) (not (apply fn args)))) ++ (lambda (&rest args) (not (apply fn args)))) + + (defun default-system-banner () + (let (gpled-modules) +--- gcl-2.6.12.orig/lsp/gcl_module.lsp ++++ gcl-2.6.12/lsp/gcl_module.lsp +@@ -40,13 +40,13 @@ + + (defun require (module-name + &optional (pathname (string-downcase (string module-name)))) +- (let ((*default-pathname-defaults* #"")) ++ (let ((*default-pathname-defaults* (make-pathname))) + (unless (member (string module-name) + *modules* + :test #'string=) + (if (atom pathname) + (load pathname) +- (do ((p pathname (cdr p))) ++ (do ((p pathname (cdr p))) + ((endp p)) + (load (car p))))))) + +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_namestring.lsp +@@ -0,0 +1,39 @@ ++(in-package :si) ++ ++(defun namestring (x) ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (typecase x ++ (string x) ++ (pathname (c-pathname-namestring x)) ++ (stream (namestring (c-stream-object1 x))))) ++ ++(defun file-namestring (x &aux (px (pathname x))) ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (namestring (make-pathname :name (pathname-name px) :type (pathname-type px) :version (pathname-version px)))) ++ ++(defun directory-namestring (x &aux (px (pathname x))) ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (namestring (make-pathname :directory (pathname-directory px)))) ++ ++(defun host-namestring (x &aux (px (pathname x))) ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (or (pathname-host px) "")) ++ ++#.`(defun enough-namestring (x &optional (def *default-pathname-defaults*) &aux (px (pathname x))(pdef (pathname def))) ++ (declare (optimize (safety 1))) ++ (check-type x pathname-designator) ++ (check-type def pathname-designator) ++ ,(labels ((new? (k &aux (f (intern (concatenate 'string "PATHNAME-" (string k)) :si))) ++ `(let ((k (,f px))) (unless (equal k (,f pdef)) k)))) ++ `(namestring (make-pathname ++ ,@(mapcan (lambda (x) (list x (new? x))) +pathname-keys+))))) ++ ++(defun faslink (file name &aux (pfile (namestring (merge-pathnames (make-pathname :type "o") (pathname file))))(*package* *package*));FIXME ++ (declare (optimize (safety 1))) ++ (check-type file pathname-designator) ++ (check-type name string) ++ (faslink-int pfile name)) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_parse_namestring.lsp +@@ -0,0 +1,139 @@ ++(in-package :si) ++ ++(deftype seqind nil `fixnum) ++ ++(defun match-beginning (i &aux (v *match-data*)) ++ (declare ((vector fixnum) v)(seqind i)) ++ (the (or (integer -1 -1 ) seqind) (aref v i))) ++(defun match-end (i &aux (v *match-data*)) ++ (declare ((vector fixnum) v)(seqind i)) ++ (the (or (integer -1 -1 ) seqind) (aref v (+ i (ash (length v) -1))))) ++ ++(declaim (inline match-beginning match-end)) ++ ++(defun dir-conj (x) (if (eq x :relative) :absolute :relative)) ++ ++(defvar *up-key* :up) ++ ++(defun mfr (x b i) (subseq x b i)); (make-array (- i b) :element-type 'character :displaced-to x :displaced-index-offset b) ++ ++(defvar *sym-sub-alist* '((:host . nil) ++ (:device . nil) ++ (:directory . (("." . nil)(".." . :up)("*" . :wild)("**" . :wild-inferiors))) ++ (:name . (("*" . :wild))) ++ (:type . (("*" . :wild))) ++ (:version . (("*" . :wild)("NEWEST" . :newest))))) ++ ++(defun element (x b i key) ++ (let* ((z (when (> i b) (mfr x b i))) ++ (w (assoc z (cdr (assoc key *sym-sub-alist*)) :test 'string-equal)) ++ (z (if w (cdr w) z))) ++ (if (eq z :up) *up-key* z))) ++ ++(defun dir-parse (x sep sepfirst &optional (b 0)) ++ (when (stringp x) ++ (let ((i (search sep x :start2 b)));string-match spoils outer match results ++ (when i ++ (let* ((y (dir-parse x sep sepfirst (1+ i))) ++ (z (element x b i :directory)) ++ (y (if z (cons z y) y))) ++ (if (zerop b) ++ (cons (if (zerop i) sepfirst (dir-conj sepfirst)) y) ++ y)))))) ++ ++(defun match-component (x i k &optional (boff 0) (eoff 0)) ++ (element x (+ (match-beginning i) boff) (+ (match-end i) eoff) k)) ++ ++(defun version-parse (x) ++ (typecase x ++ (string (version-parse (parse-integer x))) ++; (integer (locally (check-type x (integer 1)) x)) ++ (otherwise x))) ++ ++(defconstant +generic-logical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +logical-pathname-defaults+)) t t))) ++ ++(defun expand-home-dir (dir) ++ (cond ((and (eq (car dir) :relative) (stringp (cadr dir)) (eql #\~ (aref (cadr dir) 0))) ++ (append (dir-parse (home-namestring (cadr dir)) "/" :absolute) (cddr dir))) ++ (dir))) ++ ++(defun logical-pathname-parse (x &optional host def (b 0) (e (length x))) ++ (when (and (eql b (string-match +generic-logical-pathname-regexp+ x b e)) (eql (match-end 0) e)) ++ (let ((mhost (match-component x 1 :host 0 -1))) ++ (when (and host mhost) ++ (unless (string-equal host mhost) ++ (error 'error :format-control "Host part of ~s does not match ~s" :format-arguments (list x host)))) ++ (let ((host (or host mhost (pathname-host def)))) ++ (when (logical-pathname-host-p host) ++ (let* ((dir (dir-parse (match-component x 2 :none) ";" :relative)) ++ (edir (expand-home-dir dir))) ++ (make-pathname :host host ++ :device :unspecific ++ :directory edir ++ :name (match-component x 6 :name) ++ :type (match-component x 8 :type 1) ++ :version (version-parse (match-component x 11 :version 1)) ++ :namestring (when (and mhost (eql b 0) (eql e (length x)) (eq dir edir)) x)))))))) ++ ++(defconstant +generic-physical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +physical-pathname-defaults+)) t nil))) ++ ++(defun pathname-parse (x b e) ++ (when (and (eql b (string-match +generic-physical-pathname-regexp+ x b e)) (eql (match-end 0) e)) ++ (let* ((dir (dir-parse (match-component x 1 :none) "/" :absolute)) ++ (edir (expand-home-dir dir))) ++ (make-pathname :directory edir ++ :name (match-component x 3 :name) ++ :type (match-component x 4 :type 1) ++ :namestring (when (and (eql b 0) (eql e (length x)) (eq dir edir)) x))))) ++ ++ ++(defun path-stream-name (x) ++ (check-type x pathname-designator) ++ (typecase x ++ (synonym-stream (path-stream-name (symbol-value (synonym-stream-symbol x)))) ++ (stream (path-stream-name (c-stream-object1 x))) ++ (otherwise x))) ++ ++(defun parse-namestring (thing &optional host (default-pathname *default-pathname-defaults*) &rest r &key (start 0) end junk-allowed) ++ (declare (optimize (safety 1))(dynamic-extent r)) ++ (check-type thing pathname-designator) ++ (check-type host (or null (satisfies logical-pathname-translations))) ++ (check-type default-pathname pathname-designator) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ ++ (typecase thing ++ (string (let* ((e (or end (length thing))) ++ (l (logical-pathname-parse thing host default-pathname start e)) ++ (l (or l (unless host (pathname-parse thing start e))))) ++ (cond (junk-allowed (values l (max 0 (match-end 0)))) ++ (l (values l e)) ++ ((error 'parse-error :format-control "~s is not a valid pathname on host ~s" :format-arguments (list thing host)))))) ++ (stream (apply 'parse-namestring (path-stream-name thing) host default-pathname r)) ++ (pathname ++ (when host ++ (unless (string-equal host (pathname-host thing)) ++ (error 'file-error :pathname thing :format-control "Host does not match ~s" :format-arguments (list host)))) ++ (values thing start)))) ++ ++(defun pathname (spec) ++ (declare (optimize (safety 1))) ++ (check-type spec pathname-designator) ++ (if (typep spec 'pathname) spec (values (parse-namestring spec)))) ++ ++(defun sharp-p-reader (stream subchar arg) ++ (declare (ignore subchar arg)) ++ (let ((x (parse-namestring (read stream)))) x)) ++ ++(defun sharp-dq-reader (stream subchar arg);FIXME arg && read-suppress ++ (declare (ignore subchar arg)) ++ (unread-char #\" stream) ++ (let ((x (parse-namestring (read stream)))) x)) ++ ++(set-dispatch-macro-character #\# #\p 'sharp-p-reader) ++(set-dispatch-macro-character #\# #\p 'sharp-p-reader (standard-readtable)) ++(set-dispatch-macro-character #\# #\P 'sharp-p-reader) ++(set-dispatch-macro-character #\# #\P 'sharp-p-reader (standard-readtable)) ++(set-dispatch-macro-character #\# #\" 'sharp-dq-reader) ++(set-dispatch-macro-character #\# #\" 'sharp-dq-reader (standard-readtable)) ++ +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_pathname_match_p.lsp +@@ -0,0 +1,14 @@ ++(in-package :si) ++ ++(defun to-regexp (x &optional (rp t) &aux (px (pathname x))(lp (typep px 'logical-pathname))) ++ (to-regexp-or-namestring (mlp px) rp lp)) ++ ++(deftype compiled-regexp nil `(vector unsigned-char)) ++ ++(defun pathname-match-p (p w &aux (s (namestring p))) ++ (declare (optimize (safety 1))) ++ (check-type p pathname-designator) ++ (check-type w (or compiled-regexp pathname-designator)) ++ (and (zerop (string-match (if (typep w 'compiled-regexp) w (to-regexp w)) s)) ++ (eql (match-end 0) (length s)))) ++ +--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.12/lsp/gcl_predlib.lsp +@@ -110,6 +110,7 @@ + (not (array-has-fill-pointer-p x)) + (not (si:displaced-array-p x)))) + ++(defun logical-pathnamep (x) (when (pathnamep x) (eql (c-t-tt x) 1))) + + (do ((l '((null . null) + (symbol . symbolp) +@@ -124,7 +125,15 @@ + (character . characterp) + (package . packagep) + (stream . streamp) ++ (file-stream . file-stream-p) ++ (synonym-stream . synonym-stream-p) ++ (broadcast-stream . broadcast-stream-p) ++ (concatenated-stream . concatenated-stream-p) ++ (two-way-stream . two-way-stream-p) ++ (echo-stream . echo-stream-p) + (pathname . pathnamep) ++ (pathname-designator . pathname-designatorp) ++ (logical-pathname . logical-pathnamep) + (readtable . readtablep) + (hash-table . hash-table-p) + (random-state . random-state-p) +@@ -196,6 +205,8 @@ + ((null l) t) + (unless (typep object (car l)) (return nil)))) + (satisfies (funcall (car i) object)) ++ (eql (eql (car i) object)) ++ (member (member object i)) + ((t) t) + ((nil) nil) + (boolean (or (eq object 't) (eq object 'nil))) +@@ -280,6 +291,40 @@ + (typep object (apply tem i))))))) + + ++ ++(defun minmax (i1 i2 low-p e &aux (fn (if low-p (if e '< '>) (if e '> '<)))) ++ (cond ((eq i1 '*) (if e i1 i2)) ++ ((eq i2 '*) (if e i2 i1)) ++ ((funcall fn i1 i2) i1) ++ (i2))) ++ ++(defun expand-range (low high bottom top) ++ (let ((low (minmax low bottom t t))(high (minmax high top nil t))) ++ (when (or (eq low '*) (eq high '*) (<= low high)) (list low high)))) ++ ++(defun nc (tp) ++ (when (consp tp) ++ (case (car tp) ++ ;; (immfix (let ((m (cadr tp))(x (caddr tp)) ++ ;; (list (list 'integer (if (eq m '*) most-negative-immfix m) (if (eq x '*) most-positive-immfix x))))) ++ ;; (bfix (let* ((m (cadr tp))(x (caddr tp))(m (if (eq m '*) most-negative-fixnum m))(x (if (eq x '*) most-positive-fixnum x))) ++ ;; (if (< (* m x) 0) ++ ;; `((integer ,m ,(1- most-negative-immfix))(integer ,(1+ most-positive-immfix) ,x)) ++ ;; `((integer ,m ,x))))) ++ ;; (bignum (let* ((m (cadr tp))(x (caddr tp))(sm (or (eq m '*) (< m 0)))(sx (or (eq x '*) (>= x 0)))) ++ ;; (if (and sm sx) ++ ;; `((integer ,m ,(1- most-negative-fixnum))(integer ,(1+ most-positive-fixnum) ,x)) ++ ;; `((integer ,m ,x))))) ++ ((integer ratio short-float long-float) (list tp)) ++ (otherwise (append (nc (car tp)) (nc (cdr tp))))))) ++ ++ ++(defun expand-ranges (type) ++ (reduce (lambda (y x &aux (z (assoc (car x) y))) ++ (if z (subst (cons (car z) (apply 'expand-range (cadr x) (caddr x) (cdr z))) z y) ++ (cons x y))) (nc type) :initial-value nil)) ++ ++ + ;;; NORMALIZE-TYPE normalizes the type using the DEFTYPE definitions. + ;;; The result is always a list. + (defun normalize-type (type &aux tp i ) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_rename_file.lsp +@@ -0,0 +1,47 @@ ++(in-package :si) ++ ++(defun set-path-stream-name (x y) ++ (check-type x pathname-designator) ++ (typecase x ++ (synonym-stream (set-path-stream-name (symbol-value (synonym-stream-symbol x)) y)) ++ (stream (c-set-stream-object1 x y)))) ++ ++(defun rename-file (f n &aux (pf (pathname f))(pn (merge-pathnames n pf nil)) ++ (tpf (truename pf))(nf (namestring tpf)) ++ (tpn (translate-logical-pathname pn))(nn (namestring tpn))) ++ (declare (optimize (safety 1))) ++ (check-type f pathname-designator) ++ (check-type n (and pathname-designator (not stream))) ++ (unless (rename nf nn) ++ (error 'file-error :pathname pf :format-control "Cannot rename ~s to ~s." :format-arguments (list nf nn))) ++ (set-path-stream-name f pn) ++ (values pn tpf (truename tpn))) ++ ++(defun user-homedir-pathname (&optional (host :unspecific hostp)) ++ (declare (optimize (safety 1))) ++ (check-type host (or string list (eql :unspecific))) ++ (unless hostp ++ (pathname (home-namestring "~")))) ++ ++(defun delete-file (f &aux (pf (truename f))(nf (namestring pf))) ++ (declare (optimize (safety 1))) ++ (check-type f pathname-designator) ++ (unless (if (eq :directory (stat nf)) (rmdir nf) (unlink nf)) ++ (error 'file-error :pathname (pathname nf) :format-control "Cannot delete pathname.")) ++ t) ++ ++(defun file-write-date (spec) ++ (declare (optimize (safety 1))) ++ (check-type spec pathname-designator) ++ (multiple-value-bind ++ (tp sz tm) (stat (namestring (truename spec))) ++ (+ tm (* (+ 17 (* 70 365)) (* 24 60 60))))) ++ ++ ++(defun file-author (spec) ++ (declare (optimize (safety 1))) ++ (check-type spec pathname-designator) ++ (multiple-value-bind ++ (tp sz tm uid) (stat (namestring (truename spec))) ++ (uid-to-name uid))) ++ +--- gcl-2.6.12.orig/lsp/gcl_sharp.lsp ++++ gcl-2.6.12/lsp/gcl_sharp.lsp +@@ -61,4 +61,6 @@ + (otherwise x))) + + (set-dispatch-macro-character #\# #\= #'sharp-eq-reader) ++(set-dispatch-macro-character #\# #\= #'sharp-eq-reader (standard-readtable)) + (set-dispatch-macro-character #\# #\# #'sharp-sharp-reader) ++(set-dispatch-macro-character #\# #\# #'sharp-sharp-reader (standard-readtable)) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_sharp_uv.lsp +@@ -0,0 +1,29 @@ ++(in-package :si) ++ ++(defun regexp-conv (stream) ++ ++ (let ((tem (make-array 10 :element-type 'character :fill-pointer 0))) ++ (or (eql (read-char stream) #\") ++ (error "sharp-u-reader reader needs a \" right after it")) ++ (loop ++ (let ((ch (read-char stream))) ++ (cond ((eql ch #\") (return tem)) ++ ((eql ch #\\) ++ (setq ch (read-char stream)) ++ (setq ch (or (cdr (assoc ch '((#\n . #\newline) ++ (#\t . #\tab) ++ (#\r . #\return)))) ++ ch)))) ++ (vector-push-extend ch tem))) ++ tem)) ++ ++(defun sharp-u-reader (stream subchar arg) ++ (declare (ignore subchar arg)) ++ (regexp-conv stream)) ++ ++(defun sharp-v-reader (stream subchar arg) ++ (declare (ignore subchar arg)) ++ `(load-time-value (compile-regexp ,(regexp-conv stream)))) ++ ++(set-dispatch-macro-character #\# #\u 'sharp-u-reader) ++(set-dispatch-macro-character #\# #\v 'sharp-v-reader) +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -83,7 +83,7 @@ + (progn + (cond + (*multiply-stacks* (setq *multiply-stacks* nil)) +- ((probe-file "init.lsp") (load "init.lsp")))) ++ ((when (fboundp 'probe-file) (probe-file "init.lsp")) (load "init.lsp")))) + (when (if (symbolp *top-level-hook*) (fboundp *top-level-hook*) (functionp *top-level-hook*)) + (funcall *top-level-hook*))) + +@@ -122,6 +122,8 @@ + + (defvar *error-p* nil) + ++(defvar *lib-directory* nil) ++ + (defun process-some-args (args &optional compile &aux *load-verbose*) + (when args + (let ((x (pop args))) +@@ -148,7 +150,7 @@ + (file (cdr (assoc :compile compile))) + (o (cdr (assoc :o compile))) + (compile (remove :o (remove :compile compile :key 'car) :key 'car)) +- (compile (cons (cons :output-file (or o file)) compile)) +++ (compile (cons (cons :output-file (or o (merge-pathnames ".o" file))) compile)) + (result (system:error-set `(apply 'compile-file ,file ',(mapcan (lambda (x) (list (car x) (cdr x))) compile))))) + (bye (if (or *error-p* (equal result '(nil))) 1 0))))) + +@@ -520,15 +522,12 @@ add a new one, add a 'si::break-command + + ;;make sure '/' terminated + +-(defun coerce-slash-terminated (v ) +- (declare (string v)) +- (or (stringp v) (error "not a string ~a" v)) ++(defun coerce-slash-terminated (v) + (let ((n (length v))) +- (declare (fixnum n)) +- (unless (and (> n 0) (eql +- (the character(aref v (the fixnum (- n 1)))) #\/)) +- (setf v (format nil "~a/" v)))) +- v) ++ (if (and (> n 0) (eql (aref v (1- n)) #\/)) ++ v ++ (string-concatenate v "/")))) ++ + (defun fix-load-path (l) + (when (not (equal l *fixed-load-path*)) + (do ((x l (cdr x)) ) +@@ -587,19 +586,17 @@ First directory is checked for first nam + (when (and s (symbol-value s)) + (list *system-directory*)))) + +- +-(defun get-temp-dir nil +- (dolist (x `(,@(wine-tmp-redirect) ,@(mapcar 'getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) +- (when (or (stringp x) (pathnamep x)) +- (let* ((x (truename (pathname x))) +- (y (namestring (make-pathname :name (pathname-name x) :type (pathname-type x) :version (pathname-version x)))) +- (y (unless (zerop (length y)) (list y)))) +- (when (eq :directory (car (stat x))) +- (return-from get-temp-dir +- (namestring +- (make-pathname +- :device (pathname-device x) +- :directory (append (pathname-directory x) y))))))))) ++(defun ensure-dir-string (str) ++ (if (eq (stat str) :directory) ++ (coerce-slash-terminated str) ++ str)) ++ ++(defun get-temp-dir () ++ (dolist (x `(,@(wine-tmp-redirect) ,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) ++ (when x ++ (let ((x (coerce-slash-terminated x))) ++ (when (eq (stat x) :directory) ++ (return-from get-temp-dir x)))))) + + (defun get-path (s &aux (m (string-match "([^/ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1)) + (r (with-open-file (s (concatenate 'string "|which " (subseq s b e))) (read s nil 'eof)))) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_translate_pathname.lsp +@@ -0,0 +1,90 @@ ++(in-package :si) ++ ++(defun lenel (x lp) ++ (case x (:wild 1)(:wild-inferiors 2)(:absolute (if lp -1 0))(:relative (if lp 0 -1)) ++ ((:unspecific nil :newest) -1)(otherwise (length x)))) ++ ++(defun next-match (&optional (i 1) (k -1) (m (1- (ash (length *match-data*) -1)))) ++ (cond ((< k (match-beginning i) (match-end i)) i) ++ ((< i m) (next-match (1+ i) k m)) ++ (i))) ++ ++(defun mme2 (s lel lp &optional (b 0) (i (next-match)) r el ++ &aux (e (+ b (lenel (car lel) lp)))(j (match-beginning i))(k (match-end i))) ++ (cond ++ ((< (- b 2) j k (+ e 2)) ++ (let* ((z (car lel))(b1 (max b j))(e1 (min k e)) ++ (z (if (or (< b b1) (< e1 e)) (subseq z (- b1 b) (- e1 b)) z)) ++ (r (if el r (cons nil r)))) ++ (mme2 s lel lp b (next-match i k) (cons (cons z (car r)) (cdr r)) (or el (car lel))))) ++ ((< (1- j) b e (1+ k)) ++ (let ((r (if el r (cons nil r)))) ++ (mme2 s (cdr lel) lp (1+ e) i (cons (cons (car lel) (car r)) (cdr r)) (or el (list (car lel)))))) ++ ((consp el) ++ (let* ((cr (nreverse (car r)))) ++ (mme2 s lel lp b (next-match i k) (cons (cons (car el) (list cr)) (cdr r))))) ++ (el ++ (let* ((cr (nreverse (car r)))) ++ (mme2 s (cdr lel) lp (1+ e) i (cons (cons el cr) (cdr r))))) ++ (lel (mme2 s (cdr lel) lp (1+ e) i (cons (car lel) r))) ++ ((nreverse r)))) ++ ++(defun do-repl (x y) ++ (labels ((r (x l &optional (b 0) &aux (f (string-match #v"\\*" x b))) ++ (if (eql f -1) (if (eql b 0) x (subseq x b)) ++ (concatenate 'string (subseq x b f) (or (car l) "") (r x (cdr l) (1+ f)))))) ++ (r y x))) ++ ++(defun dir-p (x) (when (consp x) (member (car x) '(:absolute :relative)))) ++ ++(defun source-portion (x y) ++ (cond ++ ((or (dir-p x) (dir-p y)) ++ (mapcan (lambda (z &aux (w (source-portion ++ (if y (when (wild-dir-element-p z) (setf x (member-if 'listp x)) (pop x)) z) ++ (when y z)))) ++ (if (listp w) w (list w))) (or y x))) ++ ((if y (eq y :wild-inferiors) t) (if (listp x) (if (listp (cadr x)) (cadr x) (car x)) x));(or y) ++ ((eq y :wild) (if (listp x) (car x) x));(or y) ++ ((stringp y) (do-repl (when (listp x) (unless (listp (cadr x)) (cdr x))) y)) ++ (y))) ++ ++(defun list-toggle-case (x f) ++ (typecase x ++ (string (funcall f x)) ++ (cons (mapcar (lambda (x) (list-toggle-case x f)) x)) ++ (otherwise x))) ++ ++(defun mme3 (sx px flp tlp) ++ (list-toggle-case ++ (lnp (mme2 sx (pnl1 (mlp px)) flp)) ++ (cond ((eq flp tlp) 'identity) ++ (flp 'string-downcase) ++ (tlp 'string-upcase)))) ++ ++(defun translate-pathname (source from to &key ++ &aux (psource (pathname source)) ++ (pto (pathname to)) ++ (match (pathname-match-p source from))) ++ (declare (optimize (safety 1))) ++ (check-type source pathname-designator) ++ (check-type from pathname-designator) ++ (check-type to pathname-designator) ++ (check-type match (not null)) ++ (apply 'make-pathname :host (pathname-host pto) :device (pathname-device pto) ++ (mapcan 'list +pathname-keys+ ++ (mapcar 'source-portion ++ (mme3 (namestring source) psource (typep psource 'logical-pathname) (typep pto 'logical-pathname)) ++ (mlp pto))))) ++ ++(defun translate-logical-pathname (spec &key &aux (p (pathname spec))) ++ (declare (optimize (safety 1))) ++ (check-type spec pathname-designator) ++ (typecase p ++ (logical-pathname ++ (let ((rules (assoc p (logical-pathname-translations (pathname-host p)) :test 'pathname-match-p))) ++ (unless rules ++ (error 'file-error :pathname p :format-control "No matching translations")) ++ (translate-logical-pathname (apply 'translate-pathname p rules)))) ++ (otherwise p))) ++ +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -0,0 +1,43 @@ ++(in-package :si) ++ ++(defun link-expand (str &optional (b 0) (n (length str)) fr) ++ (labels ((frame (b e) (make-array (- n b) :element-type 'character ++ :displaced-to str :displaced-index-offset b :fill-pointer (- e b))) ++ (set-fr (fr e &aux (fr (or fr (frame 0 b)))) (setf (fill-pointer fr) e) fr)) ++ (let* ((i (string-match #v"/" str b)) ++ (fr (set-fr fr (if (eql i -1) n i))) ++ (l (when (eq (stat fr) :link) (readlinkat 0 fr)))) ++ (cond (l (let ((b (if (eql #\/ (aref l 0)) 0 b))) ++ (link-expand (concatenate 'string (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) ++ ((eql i -1) str) ++ ((link-expand str (1+ i) n fr)))))) ++ ++(defun logical-pathname-designator-p (x) ++ (typecase x ++ (string (logical-pathname-parse x)) ++ (pathname (typep x 'logical-pathname)) ++ (stream (logical-pathname-designator-p (pathname x))))) ++ ++;(defvar *current-dir* (pathname (concatenate 'string (getcwd) "/"))) FIXME sync with chdir ++ ++(defun truename (pd &aux (ppd (translate-logical-pathname pd))(ns (namestring ppd))) ++ (declare (optimize (safety 1))) ++ (check-type pd pathname-designator) ++ (when (wild-pathname-p ns) ++ (error 'file-error :pathname pd :format-control "Pathname is wild")) ++ (let* ((ns (ensure-dir-string (link-expand ns)))) ++ (unless (or (zerop (length ns)) (stat ns)) ++ (error 'file-error :pathname ns :format-control "Pathname does not exist")) ++ (let* ((d (pathname-directory ppd)) ++ (d1 (subst :back :up d)) ++ (ppd (if (eq d d1) ppd (make-pathname :directory d1 :defaults ppd)))) ++ (if (eq (car d) :absolute) ppd (merge-pathnames ppd (concatenate 'string (getcwd) "/") nil))))) ++ ++ ++(defun probe-file (pd &aux (pn (translate-logical-pathname pd))) ++ (declare (optimize (safety 1))) ++ (check-type pd pathname-designator) ++ (when (wild-pathname-p pn) ++ (error 'file-error :pathname pn :format-control "Pathname is wild")) ++ (when (eq (stat (namestring pn)) :file) ++ (truename pn))) +--- /dev/null ++++ gcl-2.6.12/lsp/gcl_wild_pathname_p.lsp +@@ -0,0 +1,28 @@ ++(in-package :si) ++ ++(defun wild-namestring-p (x) ++ (when (stringp x) (>= (string-match #v"(\\*|\\?|\\[|\\{)" x) 0))) ++ ++(defun wild-dir-element-p (x) ++ (or (eq x :wild) (eq x :wild-inferiors) (wild-namestring-p x))) ++ ++(defun wild-path-element-p (x) ++ (or (eq x :wild) (wild-namestring-p x))) ++ ++#.`(defun wild-pathname-p (pd &optional f) ++ (declare (optimize (safety 1))) ++ (check-type pd pathname-designator) ++ (check-type f (or null (member ,@+pathname-keys+))) ++ (case f ++ ((nil) (or (wild-namestring-p (namestring pd)) ++ (when (typep pd 'pathname);FIXME stream ++ (eq :wild (pathname-version pd))))) ++ ;; ((nil) (if (stringp pd) (wild-namestring-p pd) ++ ;; (let ((p (pathname pd))) ++ ;; (when (member-if (lambda (x) (wild-pathname-p p x)) +pathname-keys+) t)))) ++ ((:host :device) nil) ++ (:directory (when (member-if 'wild-dir-element-p (pathname-directory pd)) t)) ++ (:name (wild-path-element-p (pathname-name pd))) ++ (:type (wild-path-element-p (pathname-type pd))) ++ (:version (wild-path-element-p (pathname-version pd))))) ++ +--- gcl-2.6.12.orig/lsp/makefile ++++ gcl-2.6.12/lsp/makefile +@@ -13,9 +13,12 @@ OBJS = gcl_sharp.o gcl_arraylib.o gcl_as + gcl_describe.o gcl_evalmacros.o gcl_fpe.o \ + gcl_iolib.o gcl_listlib.o gcl_mislib.o gcl_module.o gcl_numlib.o \ + gcl_packlib.o gcl_predlib.o \ ++ gcl_parse_namestring.o gcl_make_pathname.o gcl_namestring.o gcl_translate_pathname.o\ ++ gcl_logical_pathname_translations.o gcl_directory.o gcl_merge_pathnames.o gcl_truename.o gcl_sharp_uv.o\ + gcl_seq.o gcl_seqlib.o gcl_setf.o gcl_top.o gcl_trace.o gcl_sloop.o \ + gcl_debug.o gcl_info.o gcl_serror.o gcl_restart.o \ +- gcl_destructuring_bind.o gcl_defpackage.o gcl_make_defpackage.o gcl_loop.o $(EXTRA_LOBJS) ++ gcl_rename_file.o gcl_pathname_match_p.o gcl_wild_pathname_p.o \ ++ gcl_destructuring_bind.o gcl_defpackage.o gcl_make_defpackage.o gcl_loop.o $(EXTRA_LOBJS) + # export.o autoload.o auto_new.o + + LISP=$(PORTDIR)/saved_pre_gcl$(EXE) +--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp ++++ gcl-2.6.12/lsp/sys-proclaim.lisp +@@ -2,361 +2,223 @@ + (COMMON-LISP::IN-PACKAGE "SYSTEM") + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- ANSI-LOOP::LOOP-EMIT-FINAL-VALUE SYSTEM::INSPECT-CHARACTER +- SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS SYSTEM::DBL-RPL-LOOP +- SYSTEM::RESTART-FUNCTION COMMON-LISP::TANH COMMON-LISP::FIFTH +- SLOOP::PARSE-LOOP-INITIALLY SYSTEM::NEXT-STACK-FRAME +- SYSTEM::IDESCRIBE SYSTEM::PROCESS-ARGS SYSTEM::LEAP-YEAR-P +- SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::FIX-LOAD-PATH +- SLOOP::SUBSTITUTE-SLOOP-BODY SYSTEM::RESTART-REPORT-FUNCTION +- COMMON-LISP::NINTH SLOOP::SLOOP-SLOOP-MACRO +- SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::FREEZE-DEFSTRUCT +- COMMON-LISP::EIGHTH SYSTEM::FIND-DOCUMENTATION +- ANSI-LOOP::LOOP-PSEUDO-BODY COMMON-LISP::RATIONAL +- ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ASIN +- COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::S-DATA-P +- SYSTEM::BKPT-FUNCTION SYSTEM::TRACE-ONE-PREPROCESS +- COMMON-LISP::LOGNOT SYSTEM::SIMPLE-ARRAY-P SYSTEM::BKPT-FILE +- SYSTEM::S-DATA-STATICP COMMON-LISP::ISQRT SYSTEM::INSTREAM-P +- COMMON-LISP::SEVENTH SYSTEM::S-DATA-NAMED +- ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-NUMBER +- COMMON-LISP::ATANH SYSTEM::RESTART-TEST-FUNCTION +- SYSTEM::S-DATA-INCLUDES SYSTEM::S-DATA-HAS-HOLES +- SYSTEM::CONTEXT-VEC FPE::XMM-LOOKUP SYSTEM::S-DATA-RAW +- ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS +- SYSTEM::RESTART-INTERACTIVE-FUNCTION +- ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS +- ANSI-LOOP::LOOP-COLLECTOR-NAME ANSI-LOOP::LOOP-PATH-NAMES +- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE +- SYSTEM::S-DATA-INCLUDED SYSTEM::S-DATA-SLOT-DESCRIPTIONS +- SYSTEM::S-DATA-OFFSET SLOOP::REPEAT-SLOOP-MACRO +- SYSTEM::S-DATA-PRINT-FUNCTION ANSI-LOOP::LOOP-PATH-USER-DATA +- COMMON-LISP::FIND-ALL-SYMBOLS COMMON-LISP::FIRST +- SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::BKPT-FORM +- SYSTEM::NODES-FROM-INDEX SYSTEM::INSPECT-SYMBOL +- SYSTEM::KNOWN-TYPE-P ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE +- SYSTEM::MAKE-DEFPACKAGE-FORM COMMON-LISP::ARRAY-DIMENSIONS +- SYSTEM::INSERT-BREAK-POINT SLOOP::PARSE-LOOP +- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED +- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS SYSTEM::SHORT-NAME +- SYSTEM::CHECK-TRACE-SPEC ANSI-LOOP::DESTRUCTURING-SIZE +- SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::CONTEXT-HASH +- COMMON-LISP::SIXTH SYSTEM::IHS-VISIBLE SYSTEM::INSPECT-ARRAY +- COMMON-LISP::BYTE-SIZE ANSI-LOOP::LOOP-COLLECTOR-CLASS +- ANSI-LOOP::LOOP-HACK-ITERATION +- ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::S-DATA-SLOT-POSITION +- ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE SYSTEM::INSPECT-STRING +- COMMON-LISP::PROVIDE COMMON-LISP::CIS +- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS +- SYSTEM::BREAK-BACKWARD-SEARCH-STACK +- ANSI-LOOP::LOOP-COLLECTOR-DTYPE +- SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK +- COMMON-LISP::TENTH ANSI-LOOP::LOOP-DO-THEREIS +- ANSI-LOOP::LOOP-MAXMIN-COLLECTION +- ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA +- ANSI-LOOP::LOOP-MAKE-PSETQ SYSTEM::ADD-TO-HOTLIST +- SYSTEM::INSPECT-CONS ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS +- SYSTEM::INSPECT-VECTOR COMMON-LISP::CONSTANTLY +- SYSTEM::REWRITE-RESTART-CASE-CLAUSE SYSTEM::DM-BAD-KEY +- SYSTEM::PRINT-SYMBOL-APROPOS SYSTEM::FRS-KIND FPE::ST-LOOKUP +- COMMON-LISP::FOURTH SYSTEM::TERMINAL-INTERRUPT +- SYSTEM::DM-KEY-NOT-ALLOWED SYSTEM::UNIQUE-ID +- SYSTEM::S-DATA-FROZEN SLOOP::POINTER-FOR-COLLECT +- SYSTEM::INSPECT-PACKAGE SYSTEM::DBL-EVAL +- ANSI-LOOP::LOOP-MINIMAX-TYPE ANSI-LOOP::LOOP-UNIVERSE-ANSI +- ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS SYSTEM::DWIM +- SYSTEM::INSTREAM-STREAM-NAME SLOOP::RETURN-SLOOP-MACRO +- SYSTEM::PATCH-SHARP SYSTEM::CONTEXT-P SYSTEM::INFO-GET-FILE +- SYSTEM::RESTART-P COMMON-LISP::COSH COMMON-LISP::SINH +- SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::CHECK-DECLARATIONS +- SYSTEM::GET-INSTREAM +- ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD SYSTEM::S-DATA-NAME +- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS +- SYSTEM::S-DATA-DOCUMENTATION SYSTEM::SHOW-BREAK-POINT +- COMMON-LISP::ACOS COMMON-LISP::INVOKE-DEBUGGER +- SYSTEM::BKPT-FILE-LINE ANSI-LOOP::LOOP-COLLECTOR-DATA +- COMMON-LISP::THIRD SYSTEM::S-DATA-CONC-NAME +- COMMON-LISP::SIGNUM +- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED +- SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-TYPED-INIT +- ANSI-LOOP::LOOP-PATH-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION +- COMMON-LISP::ASINH SYSTEM::RE-QUOTE-STRING +- SLOOP::LOOP-COLLECT-KEYWORD-P SYSTEM::PRINT-FRS +- SYSTEM::EVAL-FEATURE ANSI-LOOP::LOOP-COLLECTOR-P +- ANSI-LOOP::LOOP-COLLECTOR-HISTORY +- ANSI-LOOP::LOOP-LIST-COLLECTION +- SYSTEM::BREAK-FORWARD-SEARCH-STACK COMMON-LISP::RESTART-NAME +- SLOOP::PARSE-NO-BODY ANSI-LOOP::LOOP-UNIVERSE-P +- SYSTEM::NUMBER-OF-DAYS-FROM-1900 SYSTEM::NODE-OFFSET +- ANSI-LOOP::LOOP-MINIMAX-P SYSTEM::IHS-FNAME FPE::LOOKUP +- SLOOP::LOOP-LET-BINDINGS FPE::GREF COMMON-LISP::PHASE +- COMMON-LISP::BYTE-POSITION SYSTEM::INSTREAM-STREAM +- ANSI-LOOP::LOOP-PATH-P SYSTEM::SEQTYPE COMMON-LISP::ACOSH +- COMMON-LISP::ABS COMMON-LISP::COMPLEMENT +- ANSI-LOOP::LOOP-CONSTANTP SYSTEM::WALK-THROUGH +- SYSTEM::SETUP-INFO SYSTEM::COMPUTING-ARGS-P +- SYSTEM::CONTEXT-SPICE SYSTEM::MAKE-KCL-TOP-RESTART +- COMMON-LISP::COMPILER-MACRO-FUNCTION +- ANSI-LOOP::LOOP-MAKE-DESETQ SYSTEM::SHOW-ENVIRONMENT +- SLOOP::TRANSLATE-NAME SYSTEM::INFO-GET-TAGS +- COMMON-LISP::SECOND SYSTEM::RESET-TRACE-DECLARATIONS +- SYSTEM::S-DATA-TYPE SYSTEM::FIND-KCL-TOP-RESTART +- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::DO-F +- ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS COMMON-LISP::VECTOR-POP)) ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::ATOI)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- SYSTEM::IHS-BACKTRACE SYSTEM::BREAK-NEXT SYSTEM::BREAK-QUIT +- SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-BDS +- COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS +- SYSTEM::INFO-ERROR ANSI-LOOP::LOOP-OPTIONAL-TYPE +- SYSTEM::DBL-BACKTRACE SYSTEM::BREAK-LOCAL SYSTEM::BREAK-VS +- COMMON-LISP::CONTINUE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::OR COMMON-LISP::NULL ++ COMMON-LISP::HASH-TABLE)) ++ SYSTEM::CONTEXT-HASH)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) +- COMMON-LISP::FIXNUM) +- SYSTEM::DBL-WHAT-FRAME FPE::FE-ENABLE)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) +- COMMON-LISP::SUBTYPEP COMMON-LISP::REDUCE SYSTEM::PARSE-BODY +- COMMON-LISP::STABLE-SORT COMMON-LISP::SORT +- SLOOP::FIND-IN-ORDERED-LIST)) ++ COMMON-LISP::SUBTYPEP COMMON-LISP::REDUCE ++ SLOOP::FIND-IN-ORDERED-LIST SYSTEM::PARSE-BODY ++ COMMON-LISP::STABLE-SORT COMMON-LISP::SORT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) +- SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT +- ANSI-LOOP::LOOP-GET-COLLECTION-INFO SYSTEM::LIST-MERGE-SORT +- SYSTEM::READ-INSPECT-COMMAND SYSTEM::SHARP---READER +- SYSTEM::SHARP-+-READER SYSTEM::SHARP-S-READER)) ++ SYSTEM::SHARP-+-READER SYSTEM::SHARP---READER ++ SYSTEM::SHARP-S-READER ANSI-LOOP::LOOP-GET-COLLECTION-INFO ++ SYSTEM::VERIFY-KEYWORDS SYSTEM::LIST-MERGE-SORT ++ SYSTEM::RESTART-PRINT SYSTEM::READ-INSPECT-COMMAND)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) + COMMON-LISP::*) +- SYSTEM::PUSH-OPTIONAL-BINDING)) ++ SYSTEM::TRACE-CALL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) + COMMON-LISP::*) +- SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) ++ SYSTEM::EXPAND-WILD-DIRECTORY SYSTEM::MASET)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::*) +- SYSTEM::TRACE-CALL)) ++ SYSTEM::MME3)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::*) +- SYSTEM::MASET)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE SYSTEM::THE-START +- SYSTEM::S-DATA-LENGTH SYSTEM::S-DATA-SIZE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +- SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +- SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL +- SYSTEM::BREAK-MESSAGE SYSTEM::BREAK-RESUME +- ANSI-LOOP::LOOP-DO-FOR SYSTEM::SIMPLE-BACKTRACE +- SYSTEM::BREAK-HELP)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T) +- SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::RESET-SYS-PATHS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- COMMON-LISP::BIT COMMON-LISP::READ-BYTE +- COMMON-LISP::CONCATENATE SYSTEM::INFO-SEARCH +- COMMON-LISP::ARRAY-IN-BOUNDS-P ANSI-LOOP::LOOP-ERROR +- ANSI-LOOP::LOOP-WARN COMMON-LISP::REMOVE-DUPLICATES +- SYSTEM::BAD-SEQ-LIMIT SYSTEM::PROCESS-SOME-ARGS +- ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES +- SLOOP::LOOP-ADD-TEMPS COMMON-LISP::BIT-NOT COMMON-LISP::SIGNAL +- SYSTEM::NTH-STACK-FRAME COMMON-LISP::ARRAY-ROW-MAJOR-INDEX +- COMMON-LISP::MAKE-ARRAY SYSTEM::FILE-SEARCH +- SYSTEM::LIST-MATCHES COMMON-LISP::FIND-RESTART +- SYSTEM::BREAK-LEVEL COMMON-LISP::DELETE-DUPLICATES +- SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR COMMON-LISP::WARN +- SYSTEM::FILE-TO-STRING +- COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::SBIT)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::*) +- SYSTEM::FIND-DOC SYSTEM::RESTART-REPORT +- ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::NEWLINE +- ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEW-SEMI-COLON-READER)) ++ SYSTEM::PUSH-OPTIONAL-BINDING)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) + (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) + SYSTEM::MAKE-KEYWORD)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP +- SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::UNTRACE-ONE +- SYSTEM::CONDITIONP SYSTEM::CONDITION-CLASS-P +- SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SI-CLASS-NAME +- SYSTEM::AUTOLOAD-MACRO SYSTEM::AUTOLOAD SYSTEM::SI-CLASS-OF +- SYSTEM::WARNINGP SYSTEM::DEFINE-STRUCTURE +- FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::SI-FIND-CLASS +- SYSTEM::TRACE-ONE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + SYSTEM::QUICK-SORT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::T +- COMMON-LISP::T) ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) + SYSTEM::BIGNTHCDR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMMON-LISP::EVERY COMMON-LISP::SET-DIFFERENCE ++ SYSTEM::VECTOR-PUSH-STRING SYSTEM::PROCESS-ERROR ++ COMMON-LISP::POSITION-IF-NOT COMMON-LISP::FIND-IF ++ SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ORC1 ++ COMMON-LISP::READ-SEQUENCE SYSTEM::INTERNAL-COUNT-IF ++ COMMON-LISP::COUNT COMMON-LISP::MISMATCH ++ COMMON-LISP::ADJUST-ARRAY COMMON-LISP::INTERSECTION ++ COMMON-LISP::UNION COMMON-LISP::DELETE-IF-NOT ++ COMMON-LISP::NINTERSECTION COMMON-LISP::BIT-ANDC1 ++ COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::TYPEP ++ COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE ++ COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::REMOVE ++ COMMON-LISP::BIT-IOR SLOOP::PARSE-LOOP-MACRO ++ COMMON-LISP::SEARCH COMMON-LISP::SUBSETP ++ COMMON-LISP::SET-EXCLUSIVE-OR SYSTEM::WREADDIR ++ COMMON-LISP::POSITION-IF COMMON-LISP::DELETE ++ COMMON-LISP::BIT-EQV COMMON-LISP::BIT-ANDC2 ++ COMMON-LISP::BIT-AND COMMON-LISP::NSET-EXCLUSIVE-OR ++ SLOOP::IN-ARRAY-SLOOP-FOR ANSI-LOOP::LOOP-CHECK-DATA-TYPE ++ COMMON-LISP::POSITION COMMON-LISP::MAKE-SEQUENCE ++ COMMON-LISP::NOTEVERY COMMON-LISP::MAP-INTO ++ COMMON-LISP::REPLACE COMMON-LISP::NSET-DIFFERENCE ++ COMMON-LISP::FIND-IF-NOT COMMON-LISP::BIT-ORC2 ++ COMMON-LISP::DELETE-IF COMMON-LISP::CERROR ++ COMMON-LISP::BIT-XOR COMMON-LISP::FIND COMMON-LISP::FILL ++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::REMOVE-IF ++ COMMON-LISP::BIT-NAND COMMON-LISP::BIT-NOR COMMON-LISP::SOME ++ COMMON-LISP::COUNT-IF SYSTEM::BREAK-CALL ++ COMMON-LISP::COUNT-IF-NOT SYSTEM::FIND-IHS COMMON-LISP::NOTANY ++ SYSTEM::INTERNAL-COUNT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ANSI-LOOP::LOOP-FOR-IN +- SYSTEM::DEFMACRO* SYSTEM::APPLY-DISPLAY-FUN +- SYSTEM::WARN-VERSION ANSI-LOOP::HIDE-VARIABLE-REFERENCE +- SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-FOR-ACROSS +- SYSTEM::DM-VL SYSTEM::GET-SLOT-POS ++ SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-TRANSLATE ++ SYSTEM::CHECK-S-DATA SYSTEM::MFR FPE::REF ++ ANSI-LOOP::LOOP-STANDARD-EXPANSION ANSI-LOOP::LOOP-FOR-ON ++ ANSI-LOOP::LOOP-SUM-COLLECTION SYSTEM::SHARP-DQ-READER ++ COMMON-LISP::DPB SYSTEM::CHECK-TRACE-ARGS ++ SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS SYSTEM::RECURSE-DIR ++ SYSTEM::SHARP-U-READER SYSTEM::FLOATING-POINT-ERROR ++ ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::HIDE-VARIABLE-REFERENCE ++ SYSTEM::GET-SLOT-POS SYSTEM::APPLY-DISPLAY-FUN + SYSTEM::RESTART-CASE-EXPRESSION-CONDITION +- SYSTEM::CHECK-TRACE-ARGS ANSI-LOOP::LOOP-FOR-ON FPE::REF +- ANSI-LOOP::PRINT-LOOP-UNIVERSE ANSI-LOOP::LOOP-ANSI-FOR-EQUALS +- SYSTEM::SETF-EXPAND-1 ANSI-LOOP::LOOP-SUM-COLLECTION +- ANSI-LOOP::LOOP-STANDARD-EXPANSION SYSTEM::MAKE-T-TYPE +- COMMON-LISP::DEPOSIT-FIELD SYSTEM::MAKE-BREAK-POINT +- ANSI-LOOP::LOOP-FOR-BEING ANSI-LOOP::LOOP-TRANSLATE +- SYSTEM::SHARP-A-READER COMMON-LISP::DPB +- SYSTEM::FLOATING-POINT-ERROR SYSTEM::CHECK-S-DATA +- SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS)) ++ SYSTEM::MAKE-BREAK-POINT SYSTEM::TO-REGEXP-OR-NAMESTRING ++ COMMON-LISP::DEPOSIT-FIELD SYSTEM::SHARP-V-READER ++ SYSTEM::MAKE-T-TYPE ANSI-LOOP::LOOP-FOR-ACROSS ++ ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ANSI-LOOP::PRINT-LOOP-UNIVERSE ++ ANSI-LOOP::LOOP-FOR-BEING SYSTEM::SHARP-P-READER SYSTEM::DM-VL ++ SYSTEM::SHARP-A-READER ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ++ SYSTEM::DEFMACRO* SYSTEM::SETF-EXPAND-1 SYSTEM::WARN-VERSION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) ++ COMMON-LISP::*) + COMMON-LISP::T) +- SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION SYSTEM::DO-BREAK-LEVEL +- SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC +- SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS +- SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN)) ++ SYSTEM::MME2 COMMON-LISP::NSUBSTITUTE SYSTEM::MATCH-COMPONENT ++ SYSTEM::COMPLETE-PROP SYSTEM::WALK-DIR ++ COMMON-LISP::TRANSLATE-PATHNAME ANSI-LOOP::ADD-LOOP-PATH ++ SYSTEM::DIR-PARSE ANSI-LOOP::LOOP-MAKE-VARIABLE ++ COMMON-LISP::SUBSTITUTE-IF COMMON-LISP::NSUBSTITUTE-IF ++ SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE ++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH COMMON-LISP::MAP ++ COMMON-LISP::SUBSTITUTE-IF-NOT COMMON-LISP::NSUBSTITUTE-IF-NOT ++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH ++ SLOOP::LOOP-DECLARE-BINDING ++ ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH ++ SYSTEM::CHECK-TYPE-SYMBOL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- COMMON-LISP::COUNT-IF COMMON-LISP::BIT-ANDC2 +- COMMON-LISP::REMOVE SYSTEM::INTERNAL-COUNT-IF +- SLOOP::LOOP-ADD-BINDING COMMON-LISP::MAP-INTO +- COMMON-LISP::FIND-IF COMMON-LISP::NSET-DIFFERENCE +- COMMON-LISP::UNION COMMON-LISP::NUNION +- COMMON-LISP::MAKE-SEQUENCE COMMON-LISP::NOTANY +- COMMON-LISP::POSITION COMMON-LISP::DELETE-IF +- COMMON-LISP::BIT-ORC2 COMMON-LISP::REPLACE COMMON-LISP::DELETE +- SYSTEM::BREAK-CALL COMMON-LISP::NINTERSECTION +- COMMON-LISP::POSITION-IF SYSTEM::FIND-IHS COMMON-LISP::BIT-AND +- COMMON-LISP::DELETE-IF-NOT ANSI-LOOP::LOOP-CHECK-DATA-TYPE +- COMMON-LISP::REMOVE-IF COMMON-LISP::READ-SEQUENCE +- SLOOP::PARSE-LOOP-MACRO COMMON-LISP::BIT-NAND +- SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::SUBSETP +- COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::EVERY +- COMMON-LISP::SOME COMMON-LISP::WRITE-SEQUENCE +- COMMON-LISP::MISMATCH COMMON-LISP::SET-EXCLUSIVE-OR +- COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::BIT-NOR +- COMMON-LISP::BIT-XOR COMMON-LISP::BIT-EQV COMMON-LISP::SEARCH +- COMMON-LISP::SET-DIFFERENCE COMMON-LISP::FILL +- COMMON-LISP::CERROR COMMON-LISP::ADJUST-ARRAY +- COMMON-LISP::BIT-ORC1 SYSTEM::INTERNAL-COUNT +- COMMON-LISP::TYPEP SYSTEM::PROCESS-ERROR +- COMMON-LISP::COUNT-IF-NOT COMMON-LISP::INTERSECTION +- SLOOP::IN-ARRAY-SLOOP-FOR COMMON-LISP::FIND-IF-NOT +- COMMON-LISP::BIT-ANDC1 COMMON-LISP::POSITION-IF-NOT +- COMMON-LISP::NOTEVERY COMMON-LISP::NSET-EXCLUSIVE-OR +- COMMON-LISP::FIND COMMON-LISP::COUNT COMMON-LISP::BIT-IOR)) ++ SYSTEM::SHARP-EQ-READER SYSTEM::SHARP-SHARP-READER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) ++ SYSTEM::ELSUB SLOOP::FIRST-USE-SLOOP-FOR ++ SLOOP::FIRST-SLOOP-FOR SYSTEM::SETF-STRUCTURE-ACCESS ++ SYSTEM::FIND-LINE-IN-FUN SYSTEM::COERCE-TO-CONDITION ++ ANSI-LOOP::LOOP-FOR-ARITHMETIC SYSTEM::MAYBE-BREAK ++ SYSTEM::ELEMENT SYSTEM::DO-BREAK-LEVEL SYSTEM::CALL-TEST)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::T) +- ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::MAP +- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH +- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH +- COMMON-LISP::SUBSTITUTE COMMON-LISP::NSUBSTITUTE +- COMMON-LISP::NSUBSTITUTE-IF-NOT ANSI-LOOP::LOOP-MAKE-VARIABLE +- COMMON-LISP::SUBSTITUTE-IF-NOT +- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH +- SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE-IF +- SYSTEM::CHECK-TYPE-SYMBOL SLOOP::LOOP-DECLARE-BINDING +- SYSTEM::COMPLETE-PROP COMMON-LISP::NSUBSTITUTE-IF)) ++ ANSI-LOOP::LOOP-SEQUENCER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::MAKE-PREDICATE +- SYSTEM::MAKE-CONSTRUCTOR)) ++ SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- SYSTEM::UNIVERSAL-ERROR-HANDLER)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) ++ SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- SLOOP::DEF-LOOP-INTERNAL SYSTEM::PRINT-STACK-FRAME +- COMMON-LISP::MERGE)) ++ SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE ++ SYSTEM::PRINT-STACK-FRAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -369,154 +231,389 @@ + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- ANSI-LOOP::LOOP-SEQUENCER)) ++ SYSTEM::UNIVERSAL-ERROR-HANDLER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMMON-LISP::MERGE-PATHNAMES ++ COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME ANSI-LOOP::LOOP-ERROR ++ COMMON-LISP::WILD-PATHNAME-P SLOOP::LOOP-ADD-TEMPS ++ SYSTEM::FILE-SEARCH SYSTEM::INFO-SEARCH ++ COMMON-LISP::PATHNAME-VERSION COMMON-LISP::WARN SYSTEM::MGSUB ++ COMMON-LISP::ARRAY-ROW-MAJOR-INDEX ++ COMMON-LISP::REMOVE-DUPLICATES COMMON-LISP::PATHNAME-NAME ++ COMMON-LISP::BIT COMMON-LISP::FIND-RESTART SYSTEM::TO-REGEXP ++ SYSTEM::PROCESS-SOME-ARGS COMMON-LISP::ERROR ++ COMMON-LISP::REQUIRE COMMON-LISP::OPEN ++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE SLOOP::ADD-FROM-DATA ++ SYSTEM::BREAK-LEVEL SYSTEM::LIST-MATCHES ++ COMMON-LISP::DELETE-DUPLICATES ANSI-LOOP::LOOP-WARN ++ COMMON-LISP::PATHNAME-DEVICE COMMON-LISP::LOAD ++ COMMON-LISP::PATHNAME-HOST COMMON-LISP::SBIT SYSTEM::NLOAD ++ COMMON-LISP::BIT-NOT COMMON-LISP::ENOUGH-NAMESTRING ++ COMMON-LISP::SIGNAL COMMON-LISP::ARRAY-IN-BOUNDS-P ++ COMMON-LISP::PATHNAME-TYPE SYSTEM::FILE-TO-STRING ++ SYSTEM::LOGICAL-PATHNAME-PARSE SYSTEM::NTH-STACK-FRAME ++ ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES SYSTEM::MGLIST ++ COMMON-LISP::DIRECTORY SYSTEM::BAD-SEQ-LIMIT ++ COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::READ-BYTE ++ SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE ++ COMMON-LISP::MAKE-ARRAY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::NEWLINE SYSTEM::LIST-TOGGLE-CASE ++ COMMON-LISP::RENAME-FILE ANSI-LOOP::ESTIMATE-CODE-SIZE ++ SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT SYSTEM::DO-REPL ++ SYSTEM::FIND-DOC ANSI-LOOP::ESTIMATE-CODE-SIZE-1 ++ SYSTEM::NEW-SEMI-COLON-READER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::STRING COMMON-LISP::FIXNUM) ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::FIXNUM) +- SYSTEM::ATOI)) ++ FPE::FE-ENABLE SYSTEM::DBL-WHAT-FRAME)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::INFO SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE ++ COMMON-LISP::FTRUNCATE COMMON-LISP::USE-VALUE ++ COMMON-LISP::INVOKE-RESTART COMMON-LISP::WRITE-TO-STRING ++ COMMON-LISP::FCEILING COMMON-LISP::FROUND ++ COMMON-LISP::READ-FROM-STRING COMMON-LISP::FFLOOR ++ SYSTEM::PARSE-BODY-HEADER SYSTEM::BREAK-FUNCTION ++ SYSTEM::APROPOS-DOC COMMON-LISP::APROPOS ++ COMMON-LISP::APROPOS-LIST ++ ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE ++ COMMON-LISP::GET-SETF-EXPANSION SYSTEM::PRINT-DOC ++ COMMON-LISP::PARSE-NAMESTRING ++ COMMON-LISP::ENSURE-DIRECTORIES-EXIST ++ COMMON-LISP::DECODE-UNIVERSAL-TIME SYSTEM::SHOW-INFO ++ COMMON-LISP::STORE-VALUE SYSTEM::STEPPER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ COMMON-LISP::VECTOR-PUSH SYSTEM::DM-NTH COMMON-LISP::LOGORC1 ++ SLOOP::L-EQUAL SLOOP::NEVER-SLOOP-COLLECT ++ COMMON-LISP::LDB-TEST COMMON-LISP::LDB COMMON-LISP::LOGORC2 ++ SLOOP::COUNT-SLOOP-COLLECT SLOOP::MAXIMIZE-SLOOP-COLLECT ++ SYSTEM::ALL-MATCHES ANSI-LOOP::LOOP-TMEMBER SLOOP::THE-TYPE ++ SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR SYSTEM::SET-DIR ++ SYSTEM::DM-NTH-CDR SYSTEM::IN-INTERVAL-P SLOOP::MAKE-VALUE ++ SYSTEM::DBL-UP COMMON-LISP::COERCE SYSTEM::MATCH-DIMENSIONS ++ COMMON-LISP::LOGNAND SLOOP::=-SLOOP-FOR ++ SYSTEM::KEYWORD-SUPPLIED-P SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS ++ SYSTEM::LEFT-PARENTHESIS-READER ++ ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::COERCE-TO-STRING ++ SYSTEM::ADD-FILE SLOOP::PARSE-LOOP-MAP COMMON-LISP::LOGNOR ++ SYSTEM::MSUB SYSTEM::SET-BACK SYSTEM::SUPER-GO ++ SYSTEM::SUBSTRINGP ANSI-LOOP::LOOP-TEQUAL ++ ANSI-LOOP::LOOP-DO-WHILE SYSTEM::GET-LINE-OF-FORM ++ FPE::READ-INSTRUCTION SYSTEM::SUB-INTERVAL-P ++ SYSTEM::CHECK-SEQ-START-END SYSTEM::*BREAK-POINTS* ++ ANSI-LOOP::MAKE-LOOP-MINIMAX SLOOP::IN-PACKAGE-SLOOP-MAP ++ SYSTEM::DM-V SYSTEM::INFO-AUX ++ ANSI-LOOP::HIDE-VARIABLE-REFERENCES ++ SLOOP::COLLATE-SLOOP-COLLECT COMMON-LISP::PATHNAME-MATCH-P ++ SYSTEM::SET-PATH-STREAM-NAME SLOOP::SUM-SLOOP-COLLECT ++ ANSI-LOOP::LOOP-LOOKUP-KEYWORD ++ ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::BREAK-STEP-NEXT ++ FPE::RF SLOOP::IN-TABLE-SLOOP-MAP SYSTEM::OBJLT ++ FPE::READ-OPERANDS SYSTEM::BREAK-STEP-INTO COMMON-LISP::BYTE ++ SYSTEM::SEQUENCE-CURSOR SYSTEM::LIST-DELQ ++ SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS ++ SYSTEM::CONDITION-PASS SYSTEM::SETF-HELPER FPE::0-READER ++ SYSTEM::DISPLAY-COMPILED-ENV COMMON-LISP::NTH ++ COMPILER::COMPILER-DEF-HOOK SYSTEM::DOT-DIR-P ++ COMMON-LISP::LOGTEST SYSTEM::QUOTATION-READER ++ SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGANDC1 ++ SLOOP::ALWAYS-SLOOP-COLLECT SLOOP::DESETQ1 ++ SYSTEM::GET-INFO-CHOICES COMMON-LISP::WRITE-BYTE ++ ANSI-LOOP::LOOP-DO-IF ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION ++ ANSI-LOOP::LOOP-TASSOC SLOOP::IN-CAREFULLY-SLOOP-FOR ++ COMMON-LISP::DOCUMENTATION FPE::PAREN-READER SYSTEM::GET-NODES ++ SYSTEM::PARSE-SLOT-DESCRIPTION SLOOP::IN-FRINGE-SLOOP-MAP ++ SYSTEM::SAFE-EVAL SYSTEM::DISPLAY-ENV FPE::%-READER ++ SLOOP::THEREIS-SLOOP-COLLECT SYSTEM::LOOKUP-KEYWORD ++ COMMON-LISP::LOGANDC2 COMMON-LISP::NTHCDR ++ SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::GET-MATCH ++ SYSTEM::SETF-EXPAND SLOOP::LOGXOR-SLOOP-COLLECT ++ ANSI-LOOP::LOOP-DO-ALWAYS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::ROUND-UP)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::STEP-NEXT +- COMMON-LISP::BREAK COMMON-LISP::ABORT SYSTEM::MAKE-S-DATA +- ANSI-LOOP::MAKE-LOOP-COLLECTOR SLOOP::PARSE-LOOP-DECLARE +- ANSI-LOOP::LOOP-GENTEMP SYSTEM::MAKE-INSTREAM +- SYSTEM::MAYBE-CLEAR-INPUT +- ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL COMMON-LISP::Y-OR-N-P +- SYSTEM::CURRENT-STEP-FUN ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL +- COMMON-LISP::DRIBBLE SYSTEM::MAKE-RESTART +- SLOOP::PARSE-LOOP-WITH SYSTEM::LOC COMMON-LISP::YES-OR-NO-P +- SYSTEM::TRANSFORM-KEYWORDS SYSTEM::MAKE-CONTEXT +- COMMON-LISP::COMPUTE-RESTARTS SYSTEM::DBL-READ +- SYSTEM::STEP-INTO ANSI-LOOP::MAKE-LOOP-UNIVERSE +- SYSTEM::BREAK-LOCALS ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE +- COMMON-LISP::VECTOR ANSI-LOOP::MAKE-LOOP-PATH)) ++ COMMON-LISP::Y-OR-N-P COMMON-LISP::YES-OR-NO-P ++ COMMON-LISP::DRIBBLE COMMON-LISP::VECTOR SYSTEM::NEXT-MATCH ++ SYSTEM::MAKE-S-DATA SYSTEM::LOC SYSTEM::BREAK-LOCALS ++ SLOOP::PARSE-LOOP-WITH COMMON-LISP::USER-HOMEDIR-PATHNAME ++ SYSTEM::STEP-INTO SYSTEM::MAYBE-CLEAR-INPUT ++ ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::STEP-NEXT ++ ANSI-LOOP::LOOP-GENTEMP COMMON-LISP::COMPUTE-RESTARTS ++ SYSTEM::CURRENT-STEP-FUN SYSTEM::MAKE-INSTREAM ++ ANSI-LOOP::MAKE-LOOP-COLLECTOR SYSTEM::MAKE-RESTART ++ SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::TRANSFORM-KEYWORDS ++ COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++ ANSI-LOOP::MAKE-LOOP-UNIVERSE SLOOP::PARSE-LOOP-DECLARE ++ COMMON-LISP::BREAK ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL ++ SYSTEM::MAKE-CONTEXT SYSTEM::DBL-READ ++ COMMON-LISP::MAKE-PATHNAME ++ ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- ANSI-LOOP::LOOP-LIST-STEP SYSTEM::INSPECT-OBJECT +- COMMON-LISP::DESCRIBE ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES +- SYSTEM::BREAK-GO SYSTEM::GET-&ENVIRONMENT +- COMMON-LISP::PRINC-TO-STRING SYSTEM::WAITING +- SYSTEM::INSTREAM-NAME ANSI-LOOP::NAMED-VARIABLE +- COMMON-LISP::PRIN1-TO-STRING SYSTEM::INFO-SUBFILE +- COMMON-LISP::INSPECT SYSTEM::END-WAITING +- SYSTEM::FIND-DECLARATIONS +- COMMON-LISP::INVOKE-RESTART-INTERACTIVELY +- SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::ALOAD)) ++ ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::BREAK-GO ++ COMMON-LISP::FILE-AUTHOR SYSTEM::ENSURE-DIR-STRING ++ SYSTEM::INFO-SUBFILE COMMON-LISP::DESCRIBE SYSTEM::END-WAITING ++ COMMON-LISP::PRIN1-TO-STRING SYSTEM::FIND-DECLARATIONS ++ COMMON-LISP::INSPECT ANSI-LOOP::NAMED-VARIABLE ++ SYSTEM::GET-&ENVIRONMENT SYSTEM::INSPECT-OBJECT ++ COMMON-LISP::PRINC-TO-STRING ANSI-LOOP::LOOP-LIST-STEP ++ SYSTEM::INSTREAM-NAME SYSTEM::BREAK-LEVEL-INVOKE-RESTART ++ SYSTEM::WAITING COMMON-LISP::INVOKE-RESTART-INTERACTIVELY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ SYSTEM::IHS-NOT-INTERPRETED-ENV COMMON-LISP::NINTH ++ SYSTEM::FIND-KCL-TOP-RESTART COMMON-LISP::TRUENAME ++ SYSTEM::DIRECTORY-LIST-CHECK SYSTEM::REAL-ASINH ++ SYSTEM::SHOW-ENVIRONMENT SYSTEM::PRINT-FRS ++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE ++ COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM ++ ANSI-LOOP::LOOP-COLLECTOR-DATA SLOOP::POINTER-FOR-COLLECT ++ SYSTEM::MLP SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::LNP ++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS SYSTEM::FRS-KIND ++ SYSTEM::BKPT-FILE COMMON-LISP::FIFTH ++ ANSI-LOOP::LOOP-COLLECTOR-P ANSI-LOOP::LOOP-UNIVERSE-ANSI ++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::IDESCRIBE ++ ANSI-LOOP::LOOP-CONSTANTP ++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS COMMON-LISP::PROBE-FILE ++ ANSI-LOOP::LOOP-UNIVERSE-P COMMON-LISP::SINH SYSTEM::RESTART-P ++ SYSTEM::S-DATA-DOCUMENTATION ++ COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM ++ SYSTEM::FIND-DOCUMENTATION SYSTEM::INFO-GET-FILE ++ SLOOP::PARSE-NO-BODY COMMON-LISP::FILE-NAMESTRING ++ COMMON-LISP::COMPILER-MACRO-FUNCTION SYSTEM::PROCESS-ARGS ++ ANSI-LOOP::LOOP-COLLECTOR-DTYPE COMMON-LISP::PHASE ++ SYSTEM::MAKE-FRAME SYSTEM::INSTREAM-STREAM ++ ANSI-LOOP::LOOP-COLLECTOR-HISTORY SYSTEM::FIX-LOAD-PATH ++ SYSTEM::COMPUTING-ARGS-P ++ ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE COMMON-LISP::TENTH ++ ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::WILD-NAMESTRING-P ++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::DM-BAD-KEY ++ SYSTEM::TERMINAL-INTERRUPT SYSTEM::REGEXP-CONV ++ COMMON-LISP::FILE-WRITE-DATE SLOOP::PARSE-LOOP ++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::DWIM ++ ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS ++ SLOOP::RETURN-SLOOP-MACRO SLOOP::AVERAGING-SLOOP-MACRO ++ SYSTEM::S-DATA-NAME SYSTEM::CHECK-TRACE-SPEC ++ SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::TRANSLATE-NAME ++ SYSTEM::ADD-TO-HOTLIST SYSTEM::S-DATA-CONC-NAME ++ ANSI-LOOP::LOOP-MINIMAX-TYPE SYSTEM::PRINT-IHS ++ SYSTEM::DBL-RPL-LOOP SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY ++ SYSTEM::INSPECT-CONS SYSTEM::INSTREAM-STREAM-NAME ++ SYSTEM::S-DATA-P SYSTEM::EVAL-FEATURE ++ COMMON-LISP::ARRAY-DIMENSIONS SYSTEM::IHS-VISIBLE ++ ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE ++ SYSTEM::CHECK-DECLARATIONS COMMON-LISP::TANH ++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS ++ COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::INSPECT-PACKAGE ++ SLOOP::LOOP-LET-BINDINGS COMMON-LISP::CIS SYSTEM::SETUP-INFO ++ SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-PSEUDO-BODY ++ SYSTEM::PATH-STREAM-NAME SYSTEM::INFO-GET-TAGS FPE::ST-LOOKUP ++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK ++ ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SIMPLE-ARRAY-P ++ SYSTEM::S-DATA-TYPE COMMON-LISP::CONCATENATED-STREAM-STREAMS ++ SYSTEM::INSPECT-CHARACTER ANSI-LOOP::DESTRUCTURING-SIZE ++ SYSTEM::GET-BYTE-STREAM-NCHARS ANSI-LOOP::LOOP-PATH-P ++ COMMON-LISP::FIRST COMMON-LISP::SECOND ++ COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM ++ SYSTEM::MAKE-DEFPACKAGE-FORM SYSTEM::INSPECT-SYMBOL ++ SYSTEM::INSPECT-VECTOR ++ COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS ++ SYSTEM::RESTART-INTERACTIVE-FUNCTION SYSTEM::INSPECT-STRING ++ SYSTEM::DIR-P ANSI-LOOP::LOOP-COLLECTOR-CLASS ++ SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::NODES-FROM-INDEX ++ SYSTEM::VERSION-PARSE SYSTEM::BKPT-FILE-LINE COMMON-LISP::ABS ++ SYSTEM::IHS-FNAME ANSI-LOOP::LOOP-MAKE-PSETQ ++ SYSTEM::LEAP-YEAR-P ANSI-LOOP::LOOP-EMIT-FINAL-VALUE ++ SYSTEM::GET-PATH SYSTEM::ALOAD SYSTEM::DM-KEY-NOT-ALLOWED ++ SYSTEM::MAKE-KCL-TOP-RESTART SYSTEM::S-DATA-SLOT-DESCRIPTIONS ++ COMMON-LISP::VECTOR-POP ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS ++ ANSI-LOOP::LOOP-PATH-USER-DATA SYSTEM::S-DATA-SLOT-POSITION ++ COMMON-LISP::BROADCAST-STREAM-STREAMS ++ SYSTEM::LOGICAL-PATHNAMEP SYSTEM::BREAK-FORWARD-SEARCH-STACK ++ SLOOP::SLOOP-SLOOP-MACRO COMMON-LISP::SIGNUM ++ SYSTEM::RESET-TRACE-DECLARATIONS SYSTEM::CONTEXT-P ++ SYSTEM::S-DATA-FROZEN SYSTEM::NUMBER-OF-DAYS-FROM-1900 ++ SYSTEM::S-DATA-STATICP ANSI-LOOP::LOOP-PATH-FUNCTION ++ SYSTEM::KNOWN-TYPE-P COMMON-LISP::PROVIDE SYSTEM::PNL1 ++ ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD ++ SYSTEM::COERCE-SLASH-TERMINATED COMMON-LISP::LOGICAL-PATHNAME ++ SYSTEM::DIR-CONJ SYSTEM::BKPT-FORM ++ SYSTEM::LOGICAL-PATHNAME-HOST-P SYSTEM::INSPECT-STRUCTURE ++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++ COMMON-LISP::FIND-ALL-SYMBOLS ++ ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS ++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++ COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS ++ SYSTEM::TRACE-ONE-PREPROCESS COMMON-LISP::CONSTANTLY ++ COMMON-LISP::ACOS SYSTEM::S-DATA-OFFSET COMMON-LISP::ASINH ++ SYSTEM::SHORT-NAME SYSTEM::S-DATA-INCLUDED SYSTEM::DBL-EVAL ++ SYSTEM::BKPT-FUNCTION SYSTEM::INSPECT-NUMBER ++ SYSTEM::GET-INSTREAM SYSTEM::SHOW-BREAK-POINT FPE::LOOKUP ++ SYSTEM::NEXT-STACK-FRAME SYSTEM::INSPECT-ARRAY ++ SYSTEM::S-DATA-RAW ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA ++ SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::TOGGLE-CASE ++ SYSTEM::NODE-OFFSET SYSTEM::INSTREAM-P ++ ANSI-LOOP::LOOP-PATH-NAMES SYSTEM::FREEZE-DEFSTRUCT ++ COMMON-LISP::SEVENTH SYSTEM::SEARCH-STACK COMMON-LISP::SIXTH ++ ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS FPE::GREF ++ FPE::XMM-LOOKUP COMMON-LISP::HOST-NAMESTRING ++ ANSI-LOOP::LOOP-TYPED-INIT ++ SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P ++ ANSI-LOOP::LOOP-DO-THEREIS COMMON-LISP::EIGHTH ++ SYSTEM::UNIQUE-ID COMMON-LISP::THIRD ++ COMMON-LISP::BYTE-POSITION COMMON-LISP::SYNONYM-STREAM-SYMBOL ++ SYSTEM::PATCH-SHARP SYSTEM::PRINT-SYMBOL-APROPOS ++ COMMON-LISP::LOGNOT SLOOP::REPEAT-SLOOP-MACRO ++ COMMON-LISP::FOURTH SLOOP::SUBSTITUTE-SLOOP-BODY ++ COMMON-LISP::ATANH SLOOP::LOOP-COLLECT-KEYWORD-P ++ SYSTEM::SEQTYPE SYSTEM::RE-QUOTE-STRING COMMON-LISP::ISQRT ++ SYSTEM::DO-F SYSTEM::S-DATA-HAS-HOLES ++ ANSI-LOOP::LOOP-HACK-ITERATION ANSI-LOOP::LOOP-COLLECTOR-NAME ++ COMMON-LISP::RESTART-NAME COMMON-LISP::DIRECTORY-NAMESTRING ++ ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ACOSH ++ SYSTEM::RESTART-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION ++ COMMON-LISP::ASIN ANSI-LOOP::LOOP-LIST-COLLECTION ++ SYSTEM::S-DATA-INCLUDES SYSTEM::GET-NEXT-VISIBLE-FUN ++ COMMON-LISP::BYTE-SIZE COMMON-LISP::PATHNAME ++ ANSI-LOOP::LOOP-MINIMAX-P SLOOP::PARSE-LOOP-INITIALLY ++ COMMON-LISP::COSH SYSTEM::EXPAND-HOME-DIR ++ COMMON-LISP::ECHO-STREAM-INPUT-STREAM ++ SYSTEM::INSERT-BREAK-POINT SYSTEM::RESTART-TEST-FUNCTION ++ SYSTEM::S-DATA-PRINT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P ++ SYSTEM::S-DATA-NAMED COMMON-LISP::INVOKE-DEBUGGER ++ COMMON-LISP::NAMESTRING ANSI-LOOP::LOOP-MAKE-DESETQ ++ COMMON-LISP::COMPLEMENT SYSTEM::WALK-THROUGH ++ COMMON-LISP::RATIONAL ANSI-LOOP::LOOP-MAXMIN-COLLECTION ++ COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ SYSTEM::BREAK-QUIT SYSTEM::BREAK-BDS SYSTEM::DBL-BACKTRACE ++ SYSTEM::BREAK-LOCAL SYSTEM::INFO-ERROR ++ SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-VS ++ COMMON-LISP::CONTINUE COMMON-LISP::MUFFLE-WARNING ++ SYSTEM::IHS-BACKTRACE ANSI-LOOP::LOOP-OPTIONAL-TYPE ++ SYSTEM::BREAK-PREVIOUS SYSTEM::BREAK-NEXT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T) + COMMON-LISP::T) +- ANSI-LOOP::MAKE-LOOP-MINIMAX COMMON-LISP::LDB +- SYSTEM::LIST-DELQ FPE::RF SLOOP::L-EQUAL +- ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::DISPLAY-COMPILED-ENV +- SYSTEM::SET-BACK ANSI-LOOP::HIDE-VARIABLE-REFERENCES +- SYSTEM::GET-LINE-OF-FORM SYSTEM::BREAK-STEP-INTO +- SLOOP::THE-TYPE SLOOP::COUNT-SLOOP-COLLECT +- SYSTEM::KEYWORD-SUPPLIED-P COMMON-LISP::LOGANDC2 +- ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::SET-DIR +- SYSTEM::COERCE-TO-STRING COMMON-LISP::VECTOR-PUSH +- SYSTEM::DM-NTH-CDR SLOOP::IN-FRINGE-SLOOP-MAP +- SLOOP::MAXIMIZE-SLOOP-COLLECT SYSTEM::ADD-FILE +- SYSTEM::ALL-MATCHES SYSTEM::DM-NTH +- SLOOP::IN-CAREFULLY-SLOOP-FOR SYSTEM::PARSE-SLOT-DESCRIPTION +- ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::0-READER +- ANSI-LOOP::LOOP-TMEMBER COMPILER::COMPILER-DEF-HOOK +- SYSTEM::INFO-AUX COMMON-LISP::NTH SYSTEM::QUOTATION-READER +- SYSTEM::CHECK-SEQ-START-END COMMON-LISP::LOGNAND +- SYSTEM::SUBSTRINGP COMMON-LISP::LOGORC2 +- ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION SYSTEM::SAFE-EVAL +- ANSI-LOOP::LOOP-DO-IF SLOOP::THEREIS-SLOOP-COLLECT +- SYSTEM::MATCH-DIMENSIONS SYSTEM::GET-MATCH +- SYSTEM::SUB-INTERVAL-P FPE::PAREN-READER +- SLOOP::IN-TABLE-SLOOP-MAP COMMON-LISP::LOGTEST +- SLOOP::LOGXOR-SLOOP-COLLECT SYSTEM::DM-V +- SYSTEM::GET-INFO-CHOICES SLOOP::COLLATE-SLOOP-COLLECT +- SYSTEM::BREAK-STEP-NEXT ANSI-LOOP::LOOP-TEQUAL +- COMMON-LISP::WRITE-BYTE COMMON-LISP::NTHCDR +- SYSTEM::SETF-HELPER SLOOP::NEVER-SLOOP-COLLECT SLOOP::DESETQ1 +- ANSI-LOOP::LOOP-DO-WHILE COMMON-LISP::DOCUMENTATION +- FPE::%-READER SYSTEM::IN-INTERVAL-P SLOOP::SUM-SLOOP-COLLECT +- SYSTEM::OBJLT COMMON-LISP::LDB-TEST SLOOP::PARSE-LOOP-MAP +- SYSTEM::GET-NODES SLOOP::MAKE-VALUE SYSTEM::CONDITION-PASS +- SLOOP::IN-PACKAGE-SLOOP-MAP SYSTEM::INCREMENT-CURSOR +- ANSI-LOOP::LOOP-DO-ALWAYS SYSTEM::DISPLAY-ENV SYSTEM::SUPER-GO +- SLOOP::MINIMIZE-SLOOP-COLLECT COMMON-LISP::LOGNOR +- COMMON-LISP::LOGANDC1 COMMON-LISP::BYTE SYSTEM::DBL-UP +- SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGORC1 +- FPE::READ-OPERANDS SLOOP::ALWAYS-SLOOP-COLLECT +- SYSTEM::SETF-EXPAND SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS +- SYSTEM::*BREAK-POINTS* SYSTEM::LOOKUP-KEYWORD +- ANSI-LOOP::LOOP-TASSOC SYSTEM::LEFT-PARENTHESIS-READER +- SLOOP::=-SLOOP-FOR FPE::READ-INSTRUCTION COMMON-LISP::COERCE +- SYSTEM::SEQUENCE-CURSOR)) ++ SYSTEM::SMALLNTHCDR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMMON-LISP::FFLOOR SYSTEM::BREAK-FUNCTION +- COMMON-LISP::APROPOS-LIST COMMON-LISP::DECODE-UNIVERSAL-TIME +- SYSTEM::STEPPER COMMON-LISP::REQUIRE SYSTEM::APROPOS-DOC +- SYSTEM::PRINT-DOC SYSTEM::INFO COMMON-LISP::USE-VALUE +- COMMON-LISP::WRITE-TO-STRING COMMON-LISP::FCEILING +- SYSTEM::GET-SETF-METHOD +- ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE SYSTEM::NLOAD +- COMMON-LISP::ENSURE-DIRECTORIES-EXIST +- COMMON-LISP::WILD-PATHNAME-P COMMON-LISP::FTRUNCATE +- COMMON-LISP::FROUND SYSTEM::PARSE-BODY-HEADER +- COMMON-LISP::INVOKE-RESTART SYSTEM::SHOW-INFO +- COMMON-LISP::READ-FROM-STRING +- SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE COMMON-LISP::APROPOS +- COMMON-LISP::STORE-VALUE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ COMMON-LISP::HASH-TABLE) ++ SYSTEM::CONTEXT-SPICE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- ANSI-LOOP::LOOP-DO-WITH SYSTEM::WINE-TMP-REDIRECT +- SLOOP::PARSE-ONE-WHEN-CLAUSE COMMON-LISP::TYPE-ERROR +- SYSTEM::INSPECT-INDENT SYSTEM::SET-CURRENT SYSTEM::TEST-ERROR +- SLOOP::LOOP-POP ANSI-LOOP::LOOP-DO-REPEAT +- ANSI-LOOP::LOOP-GET-PROGN SYSTEM::DM-TOO-FEW-ARGUMENTS +- ANSI-LOOP::LOOP-CONTEXT SYSTEM::READ-EVALUATED-FORM +- SYSTEM::ALL-TRACE-DECLARATIONS +- COMMON-LISP::LISP-IMPLEMENTATION-VERSION +- SYSTEM::DEFAULT-SYSTEM-BANNER ANSI-LOOP::LOOP-DO-RETURN +- SYSTEM::INSPECT-INDENT-1 SYSTEM::STEP-READ-LINE +- SYSTEM::SET-ENV SYSTEM::DM-TOO-MANY-ARGUMENTS +- ANSI-LOOP::LOOP-BIND-BLOCK SLOOP::PARSE-LOOP1 +- ANSI-LOOP::LOOP-DO-NAMED SLOOP::PARSE-LOOP-COLLECT +- SYSTEM::KCL-TOP-RESTARTS SYSTEM::INSPECT-READ-LINE +- SYSTEM::SET-UP-TOP-LEVEL SYSTEM::SHOW-RESTARTS SYSTEM::DBL +- SLOOP::PARSE-LOOP-FOR ANSI-LOOP::LOOP-ITERATION-DRIVER +- ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ANSI-LOOP::LOOP-DO-DO +- SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::GET-TEMP-DIR +- ANSI-LOOP::LOOP-POP-SOURCE SLOOP::LOOP-UN-POP +- SYSTEM::TOP-LEVEL ANSI-LOOP::LOOP-DO-FINALLY +- ANSI-LOOP::LOOP-DO-INITIALLY SYSTEM::GET-INDEX-NODE +- SYSTEM::SETUP-LINEINFO SLOOP::PARSE-LOOP-WHEN SYSTEM::CLEANUP +- ANSI-LOOP::LOOP-GET-FORM SLOOP::PARSE-LOOP-DO +- SYSTEM::INIT-BREAK-POINTS SLOOP::LOOP-PEEK +- SYSTEM::GET-SIG-FN-NAME SYSTEM::ILLEGAL-BOA)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE ++ SYSTEM::S-DATA-LENGTH SYSTEM::THE-START)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++ SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(SYSTEM::CONDITION-CLASS-P SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF ++ SYSTEM::SI-FIND-CLASS SYSTEM::DEFINE-STRUCTURE ++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS ++ SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::AUTOLOAD ++ SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASS-NAME ++ SYSTEM::TRACE-ONE SYSTEM::MAKE-ACCESS-FUNCTION ++ SYSTEM::UNTRACE-ONE SYSTEM::SI-CLASSP SYSTEM::CONDITIONP ++ SYSTEM::AUTOLOAD-MACRO)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- SYSTEM::SMALLNTHCDR)) ++ SYSTEM::GET-CONTEXT SYSTEM::PUSH-CONTEXT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- SYSTEM::THE-END ANSI-LOOP::DUPLICATABLE-CODE-P +- SYSTEM::RELATIVE-LINE SYSTEM::GET-NODE-INDEX)) ++ SYSTEM::RELATIVE-LINE SYSTEM::LENEL SYSTEM::THE-END ++ ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::FASLINK ++ SYSTEM::GET-NODE-INDEX)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ SLOOP::PARSE-ONE-WHEN-CLAUSE ANSI-LOOP::LOOP-DO-FINALLY ++ SLOOP::LOOP-PEEK ANSI-LOOP::LOOP-DO-INITIALLY SLOOP::LOOP-POP ++ ANSI-LOOP::LOOP-GET-PROGN SYSTEM::KCL-TOP-RESTARTS ++ SYSTEM::INSPECT-READ-LINE SLOOP::PARSE-LOOP-WHEN ++ ANSI-LOOP::LOOP-GET-FORM SYSTEM::DEFAULT-SYSTEM-BANNER ++ SYSTEM::SET-UP-TOP-LEVEL SYSTEM::GET-INDEX-NODE ++ ANSI-LOOP::LOOP-DO-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ++ SYSTEM::SETUP-LINEINFO COMMON-LISP::TYPE-ERROR ++ SYSTEM::READ-EVALUATED-FORM SYSTEM::INSPECT-INDENT-1 ++ SLOOP::LOOP-UN-POP SLOOP::PARSE-LOOP-DO ++ ANSI-LOOP::LOOP-DO-WITH SYSTEM::INSPECT-INDENT ++ SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER ++ SYSTEM::WINE-TMP-REDIRECT SLOOP::PARSE-LOOP-COLLECT ++ SYSTEM::DEFAULT-INFO-HOTLIST SLOOP::PARSE-LOOP1 ++ SYSTEM::CLEANUP ANSI-LOOP::LOOP-DO-NAMED SYSTEM::DBL ++ SYSTEM::ALL-TRACE-DECLARATIONS SYSTEM::TEST-ERROR ++ ANSI-LOOP::LOOP-BIND-BLOCK ANSI-LOOP::LOOP-DO-REPEAT ++ SYSTEM::ILLEGAL-BOA SYSTEM::SET-ENV SYSTEM::SET-CURRENT ++ SYSTEM::INIT-BREAK-POINTS SYSTEM::GET-SIG-FN-NAME ++ ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-CONTEXT ++ SYSTEM::SHOW-RESTARTS SYSTEM::STEP-READ-LINE ++ SLOOP::PARSE-LOOP-FOR SYSTEM::DM-TOO-MANY-ARGUMENTS ++ COMMON-LISP::LISP-IMPLEMENTATION-VERSION SYSTEM::TOP-LEVEL ++ ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::DM-TOO-FEW-ARGUMENTS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) +- COMMON-LISP::FIXNUM) +- SYSTEM::ROUND-UP)) ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*)) ++ COMMON-LISP::T) ++ SYSTEM::RESET-SYS-PATHS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::VECTOR COMMON-LISP::T)) ++ SYSTEM::CONTEXT-VEC)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ SYSTEM::BREAK-HELP SYSTEM::BREAK-MESSAGE ++ SYSTEM::SIMPLE-BACKTRACE ANSI-LOOP::LOOP-DO-FOR ++ SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL ++ SYSTEM::BREAK-RESUME)) +\ No newline at end of file +--- gcl-2.6.12.orig/o/alloc.c ++++ gcl-2.6.12/o/alloc.c +@@ -447,7 +447,6 @@ set_tm_maxpage(struct typemanager *tm,fi + + fixnum r=tm->tm_type==t_relocatable,j=tm->tm_maxpage,z=(n-j)*(r ? 2 : 1); + if (z>available_pages) return 0; +- if (r && 2*n+page(rb_start)>real_maxpage) return 0; + available_pages-=z; + tm->tm_adjgbccnt*=((double)j+1)/(n+1); + tm->tm_maxpage=n; +@@ -909,7 +908,7 @@ alloc_after_reclaiming_pages(struct type + + fixnum m=tpage(tm,n),reloc_min; + +- if (tm->tm_type>=t_end) return NULL; ++ if (tm->tm_type>t_end) return NULL; + + reloc_min=npage(rb_pointer-rb_start); + +@@ -925,6 +924,8 @@ alloc_after_reclaiming_pages(struct type + + } + ++ if (tm->tm_type>=t_end) return NULL; ++ + maybe_reallocate_page(tm,tm->tm_percent_free*tm->tm_npage); + + return alloc_from_freelist(tm,n); +@@ -1093,8 +1094,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocate + RV(make_fixnum(tm->tm_maxpage)), + RV(make_fixnum(tm->tm_nppage)), + RV(make_fixnum(tm->tm_gbccount)), +- RV(make_fixnum(tm->tm_npage*tm->tm_nppage-tm->tm_nfree)) +- )); ++ RV(make_fixnum(tm->tm_npage*tm->tm_nppage-tm->tm_nfree)))); + } + + #ifdef SGC_CONT_DEBUG +@@ -1658,7 +1658,7 @@ DEFUN_NEW("GPROF-QUIT",object,fSgprof_qu + massert(getcwd(b,sizeof(b))); + massert(!chdir(P_tmpdir)); + _mcleanup(); +- massert(snprintf(b1,sizeof(b1),"gprof %s",kcl_self)>0); ++ massert(snprintf(b1,sizeof(b1),"gprof '%s'",kcl_self)>0); + massert((pp=popen(b1,"r"))); + while ((n=fread(b1,1,sizeof(b1),pp))) + massert(fwrite(b1,1,n,stdout)); +--- gcl-2.6.12.orig/o/array.c ++++ gcl-2.6.12/o/array.c +@@ -1139,9 +1139,9 @@ Icheck_displaced(object displaced_list, + /* } */ + /* } */ + +-DEFUNO_NEW("REPLACE-ARRAY",object,fSreplace_array,SI,2,2,NONE, +- OO,OO,OO,OO,void,siLreplace_array,(object old,object new),"") +-{ struct dummy fw ; ++DEFUN_NEW("REPLACE-ARRAY",object,fSreplace_array,SI,2,2,NONE,OO,OO,OO,OO,(object old,object new),"") { ++ ++ struct dummy fw; + fw = old->d; + + old = IisArray(old); +--- gcl-2.6.12.orig/o/bind.c ++++ gcl-2.6.12/o/bind.c +@@ -24,7 +24,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + */ + + #include "include.h" +-#include + + static void + illegal_lambda(void); +@@ -95,17 +94,19 @@ lambda_bind(object *arg_top) + struct aux *aux=NULL; + int naux; + bool special_processed; ++ object s[1],ss; + vs_mark; + + bds_check; + lambda = vs_head; +- if (type_of(lambda) != t_cons) ++ if (!consp(lambda)) + FEerror("No lambda list.", 0); + lambda_list = lambda->c.c_car; + body = lambda->c.c_cdr; + + required = (struct required *)vs_top; + nreq = 0; ++ s[0]=Cnil; + for (;;) { + if (endp(lambda_list)) + goto REQUIRED_ONLY; +@@ -152,7 +153,7 @@ OPTIONAL: + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; +- if (type_of(x) == t_cons) { ++ if (consp(x)) { + check_symbol(x->c.c_car); + check_var(x->c.c_car); + vs_push(x->c.c_car); +@@ -226,9 +227,9 @@ KEYWORD: + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; +- if (type_of(x) == t_cons) { +- if (type_of(x->c.c_car) == t_cons) { +- if (!keywordp(x->c.c_car->c.c_car)) ++ if (consp(x)) { ++ if (consp(x->c.c_car)) { ++ if (type_of(x->c.c_car->c.c_car)!=t_symbol) + /* FIXME better message */ + FEunexpected_keyword(x->c.c_car->c.c_car); + vs_push(x->c.c_car->c.c_car); +@@ -296,7 +297,7 @@ AUX_L: + goto SEARCH_DECLARE; + x = lambda_list->c.c_car; + lambda_list = lambda_list->c.c_cdr; +- if (type_of(x) == t_cons) { ++ if (consp(x)) { + check_symbol(x->c.c_car); + check_var(x->c.c_car); + vs_push(x->c.c_car); +@@ -336,10 +337,10 @@ SEARCH_DECLARE: + break; + continue; + } +- if (type_of(form)!=t_cons || !isdeclare(form->c.c_car)) ++ if (!consp(form) || !isdeclare(form->c.c_car)) + break; + for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { +- if (type_of(ds->c.c_car) != t_cons) ++ if (!consp(ds->c.c_car)) + illegal_declare(form); + if (ds->c.c_car->c.c_car == sLspecial) { + vs = ds->c.c_car->c.c_cdr; +@@ -381,8 +382,7 @@ SEARCH_DECLARE: + } + if (special_processed) + continue; +- /* lex_special_bind(v); */ +- lex_env[0] = MMcons(MMcons(v, Cnil), lex_env[0]); ++ s[0] = MMcons(MMcons(v, Cnil), s[0]); + + /**/ + } +@@ -437,17 +437,20 @@ SEARCH_DECLARE: + bind_var(rest->rest_var, vs_head, rest->rest_spp); + } + if (key_flag) { ++ int allow_other_keys_found=0; + i = narg - nreq - nopt; + if (i >= 0 && i%2 != 0) + /* FIXME better message */ + FEunexpected_keyword(Cnil); + other_keys_appeared = FALSE; + for (i = nreq + nopt; i < narg; i += 2) { +- if (!keywordp(base[i])) ++ if (type_of(base[i])!=t_symbol) + FEunexpected_keyword(base[i]); +- if (base[i] == sKallow_other_keys && +- base[i+1] != Cnil) ++ if (base[i] == sKallow_other_keys && !allow_other_keys_found) { ++ allow_other_keys_found=1; ++ if (base[i+1] != Cnil) + allow_other_keys_flag = TRUE; ++ } + for (j = 0; j < nkey; j++) { + if (keyword[j].key_word == base[i]) { + if (keyword[j].key_svar_val +@@ -460,7 +463,8 @@ SEARCH_DECLARE: + goto NEXT_ARG; + } + } +- other_keys_appeared = TRUE; ++ if (base[i] != sKallow_other_keys) ++ other_keys_appeared = TRUE; + + NEXT_ARG: + continue; +@@ -492,7 +496,7 @@ SEARCH_DECLARE: + eval_assign(temporary, aux[i].aux_init); + bind_var(aux[i].aux_var, temporary, aux[i].aux_spp); + } +- if (type_of(body) != t_cons || body->c.c_car == form) { ++ if (!consp(body) || body->c.c_car == form) { + vs_reset; + vs_head = body; + } else { +@@ -500,6 +504,13 @@ SEARCH_DECLARE: + vs_reset; + vs_head = body; + } ++ ++ if (s[0]!=Cnil) { ++ for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); ++ ss->c.c_cdr=lex_env[0]; ++ lex_env[0]=s[0]; ++ } ++ + return; + + REQUIRED_ONLY: +@@ -515,10 +526,10 @@ REQUIRED_ONLY: + break; + continue; + } +- if (type_of(form)!=t_cons || !isdeclare(form->c.c_car)) ++ if (!consp(form) || !isdeclare(form->c.c_car)) + break; + for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { +- if (type_of(ds->c.c_car) != t_cons) ++ if (!consp(ds->c.c_car)) + illegal_declare(form); + if (ds->c.c_car->c.c_car == sLspecial) { + vs = ds->c.c_car->c.c_cdr; +@@ -537,7 +548,7 @@ REQUIRED_ONLY: + continue; + /* lex_special_bind(v); */ + temporary = MMcons(v, Cnil); +- lex_env[0] = MMcons(temporary, lex_env[0]); ++ s[0] = MMcons(temporary, s[0]); + + /**/ + } +@@ -555,7 +566,7 @@ REQUIRED_ONLY: + bind_var(required[i].req_var, + base[i], + required[i].req_spp); +- if (type_of(body) != t_cons || body->c.c_car == form) { ++ if (!consp(body) || body->c.c_car == form) { + vs_reset; + vs_head = body; + } else { +@@ -563,6 +574,13 @@ REQUIRED_ONLY: + vs_reset; + vs_head = body; + } ++ ++ if (s[0]!=Cnil) { ++ for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); ++ ss->c.c_cdr=lex_env[0]; ++ lex_env[0]=s[0]; ++ } ++ + } + + void +@@ -612,7 +630,7 @@ struct bind_temp { + */ + + object +-find_special(object body, struct bind_temp *start, struct bind_temp *end) ++find_special(object body, struct bind_temp *start, struct bind_temp *end,object *s) + { + object temporary; + object form=Cnil; +@@ -622,6 +640,7 @@ find_special(object body, struct bind_te + vs_mark; + + vs_push(Cnil); ++ s=s ? s : lex_env; + for (; !endp(body); body = body->c.c_cdr) { + form = body->c.c_car; + +@@ -634,10 +653,10 @@ find_special(object body, struct bind_te + break; + continue; + } +- if (type_of(form)!=t_cons || !isdeclare(form->c.c_car)) ++ if (!consp(form) || !isdeclare(form->c.c_car)) + break; + for (ds = form->c.c_cdr; !endp(ds); ds = ds->c.c_cdr) { +- if (type_of(ds->c.c_car) != t_cons) ++ if (!consp(ds->c.c_car)) + illegal_declare(form); + if (ds->c.c_car->c.c_car == sLspecial) { + vs = ds->c.c_car->c.c_cdr; +@@ -655,14 +674,14 @@ find_special(object body, struct bind_te + continue; + /* lex_special_bind(v); */ + temporary = MMcons(v, Cnil); +- lex_env[0] = MMcons(temporary, lex_env[0]); ++ s[0] = MMcons(temporary, s[0]); + /**/ + } + } + } + } + +- if (body != Cnil && body->c.c_car != form) ++ if (body != Cnil && body->c.c_car != form && type_of(form)==t_cons && isdeclare(form->c.c_car))/*FIXME*/ + body = make_cons(form, body->c.c_cdr); + vs_reset; + return(body); +@@ -674,10 +693,10 @@ let_bind(object body, struct bind_temp * + struct bind_temp *bt; + + bds_check; +- vs_push(find_special(body, start, end)); + for (bt = start; bt < end; bt++) { + eval_assign(bt->bt_init, bt->bt_init); + } ++ vs_push(find_special(body, start, end,NULL)); + for (bt = start; bt < end; bt++) { + bind_var(bt->bt_var, bt->bt_init, bt->bt_spp); + } +@@ -688,13 +707,20 @@ object + letA_bind(object body, struct bind_temp *start, struct bind_temp *end) + { + struct bind_temp *bt; +- ++ object s[1],ss; ++ + bds_check; +- vs_push(find_special(body, start, end)); ++ s[0]=Cnil; ++ vs_push(find_special(body, start, end,s)); + for (bt = start; bt < end; bt++) { + eval_assign(bt->bt_init, bt->bt_init); + bind_var(bt->bt_var, bt->bt_init, bt->bt_spp); + } ++ if (s[0]!=Cnil) { ++ for (ss=s[0];ss->c.c_cdr!=Cnil;ss=ss->c.c_cdr); ++ ss->c.c_cdr=lex_env[0]; ++ lex_env[0]=s[0]; ++ } + return(vs_pop); + } + +@@ -703,12 +729,12 @@ letA_bind(object body, struct bind_temp + + #endif + +-#define NOT_YET 10 +-#define FOUND 11 ++#define NOT_YET stp_ordinary ++#define FOUND stp_special + #define NOT_KEYWORD 1 + + void +-parse_key(object *base, bool rest, bool allow_other_keys,int n, ...) ++parse_key(object *base, bool rest, bool allow_other_keys, int n, ...) + { + object temporary; + va_list ap; +@@ -735,7 +761,7 @@ parse_key(object *base, bool rest, bool + FEunexpected_keyword(Cnil); + if (narg == 2) { + k = base[0]; +- if (!keywordp(k)) ++ if (type_of(k)!=t_symbol) + FEunexpected_keyword(k); + if (k == sKallow_other_keys && ! allow_other_keys_found) { + allow_other_keys_found=1; +@@ -777,7 +803,7 @@ parse_key(object *base, bool rest, bool + va_end(ap); + for (v = base; v < vs_top; v += 2) { + k = v[0]; +- if (!keywordp(k)) { ++ if (type_of(k)!=t_symbol) { + error_flag = NOT_KEYWORD; + other_key = k; + continue; +@@ -827,16 +853,19 @@ check_other_key(object l, int n, ...) + object k; + int i; + bool allow_other_keys = FALSE; ++ int allow_other_keys_found=0; + + for (; !endp(l); l = l->c.c_cdr->c.c_cdr) { + k = l->c.c_car; +- if (!keywordp(k)) ++ if (type_of(k)!=t_symbol) + FEunexpected_keyword(k); + if (endp(l->c.c_cdr)) + /* FIXME better message */ + FEunexpected_keyword(Cnil); +- if (k == sKallow_other_keys && l->c.c_cdr->c.c_car != Cnil) { +- allow_other_keys = TRUE; ++ if (k == sKallow_other_keys && !allow_other_keys_found) { ++ allow_other_keys_found=1; ++ if (l->c.c_cdr->c.c_car != Cnil) ++ allow_other_keys = TRUE; + } else { + char buf [100]; + bzero(buf,n); +@@ -1110,7 +1139,7 @@ gcl_init_bind(void) + make_cons(make_ordinary("&BODY"), Cnil))))))))); + + make_constant("LAMBDA-PARAMETERS-LIMIT", +- make_fixnum(64)); ++ make_fixnum(MAX_ARGS+1)); + + + +--- gcl-2.6.12.orig/o/error.c ++++ gcl-2.6.12/o/error.c +@@ -490,49 +490,78 @@ vfun_wrong_number_of_args(object x) + + + void +-check_arg_range(int n, int m) +-{ +- object x,x1; ++check_arg_range(int n, int m) { + +- x=make_fixnum(n); +- x1=make_fixnum(VFUN_NARGS); + if (VFUN_NARGS < n) +- Icall_error_handler( +- sKtoo_few_arguments, +- make_simple_string("Needed at least ~D args, but received ~d"), +- 2,x,x1); +- else if (VFUN_NARGS > m) +- Icall_error_handler( +- sKtoo_many_arguments, +- make_simple_string("Needed no more than ~D args, but received ~d"), +- 2,x,x1); +- } ++ FEtoo_few_arguments(0,VFUN_NARGS); ++ if (VFUN_NARGS > m) ++ FEtoo_many_arguments(0,VFUN_NARGS); ++ ++} + + + DEF_ORDINARY("TERMINAL-INTERRUPT",sSterminal_interrupt,SI,""); +-DEF_ORDINARY("WRONG-TYPE-ARGUMENT",sKwrong_type_argument,KEYWORD,""); +-DEF_ORDINARY("TOO-FEW-ARGUMENTS",sKtoo_few_arguments,KEYWORD,""); +-DEF_ORDINARY("TOO-MANY-ARGUMENTS",sKtoo_many_arguments,KEYWORD,""); +-DEF_ORDINARY("UNEXPECTED-KEYWORD",sKunexpected_keyword,KEYWORD,""); +-DEF_ORDINARY("INVALID-FORM",sKinvalid_form,KEYWORD,""); +-DEF_ORDINARY("UNBOUND-VARIABLE",sKunbound_variable,KEYWORD,""); +-DEF_ORDINARY("INVALID-VARIABLE",sKinvalid_variable,KEYWORD,""); +-DEF_ORDINARY("UNDEFINED-FUNCTION",sKundefined_function,KEYWORD,""); +-DEF_ORDINARY("INVALID-FUNCTION",sKinvalid_function,KEYWORD,""); +-DEF_ORDINARY("PACKAGE-ERROR",sKpackage_error,KEYWORD,""); +-DEF_ORDINARY("DATUM",sKdatum,KEYWORD,""); +-DEF_ORDINARY("EXPECTED-TYPE",sKexpected_type,KEYWORD,""); +-DEF_ORDINARY("PACKAGE",sKpackage,KEYWORD,""); +-DEF_ORDINARY("FORMAT-CONTROL",sKformat_control,KEYWORD,""); +-DEF_ORDINARY("FORMAT-ARGUMENTS",sKformat_arguments,KEYWORD,""); + DEF_ORDINARY("CATCH",sKcatch,KEYWORD,""); + DEF_ORDINARY("PROTECT",sKprotect,KEYWORD,""); + DEF_ORDINARY("CATCHALL",sKcatchall,KEYWORD,""); + + ++DEF_ORDINARY("CONDITION",sLcondition,LISP,""); ++DEF_ORDINARY("SERIOUS-CONDITION",sLserious_condition,LISP,""); ++DEF_ORDINARY("SIMPLE-CONDITION",sLsimple_condition,LISP,""); ++ ++DEF_ORDINARY("ERROR",sLerror,LISP,""); ++DEF_ORDINARY("SIMPLE-ERROR",sLsimple_error,LISP,""); ++DEF_ORDINARY("FORMAT-CONTROL",sKformat_control,KEYWORD,""); ++DEF_ORDINARY("FORMAT-ARGUMENTS",sKformat_arguments,KEYWORD,""); ++ ++DEF_ORDINARY("TYPE-ERROR",sLtype_error,LISP,""); ++DEF_ORDINARY("DATUM",sKdatum,KEYWORD,""); ++DEF_ORDINARY("EXPECTED-TYPE",sKexpected_type,KEYWORD,""); ++DEF_ORDINARY("SIMPLE-TYPE-ERROR",sLsimple_type_error,LISP,""); ++ ++DEF_ORDINARY("PROGRAM-ERROR",sLprogram_error,LISP,""); ++DEF_ORDINARY("CONTROL-ERROR",sLcontrol_error,LISP,""); ++DEF_ORDINARY("PACKAGE-ERROR",sLpackage_error,LISP,""); ++DEF_ORDINARY("PACKAGE",sKpackage,KEYWORD,""); ++ ++DEF_ORDINARY("STREAM-ERROR",sLstream_error,LISP,""); ++DEF_ORDINARY("STREAM",sKstream,KEYWORD,""); ++DEF_ORDINARY("END-OF-FILE",sLend_of_file,LISP,""); ++ ++DEF_ORDINARY("FILE-ERROR",sLfile_error,LISP,""); ++DEF_ORDINARY("PATHNAME",sKpathname,KEYWORD,""); ++ ++DEF_ORDINARY("CELL-ERROR",sLcell_error,LISP,""); ++DEF_ORDINARY("NAME",sKname,KEYWORD,""); ++DEF_ORDINARY("UNBOUND-SLOT",sLunbound_slot,LISP,""); ++DEF_ORDINARY("UNBOUND-VARIABLE",sLunbound_variable,LISP,""); ++DEF_ORDINARY("UNDEFINED-FUNCTION",sLundefined_function,LISP,""); ++ ++DEF_ORDINARY("ARITHMETIC-ERROR",sLarithmetic_error,LISP,""); ++DEF_ORDINARY("OPERATION",sKoperation,KEYWORD,""); ++DEF_ORDINARY("OPERANDS",sKoperands,KEYWORD,""); ++DEF_ORDINARY("DIVISION-BY-ZERO",sLdivision_by_zero,LISP,""); ++DEF_ORDINARY("FLOATING-POINT-OVERFLOW",sLfloating_point_overflow,LISP,""); ++DEF_ORDINARY("FLOATING-POINT-UNDERFLOW",sLfloating_point_underflow,LISP,""); ++DEF_ORDINARY("FLOATING-POINT-INEXACT",sLfloating_point_inexact,LISP,""); ++DEF_ORDINARY("FLOATING-POINT-INVALID-OPERATION",sLfloating_point_invalid_operation,LISP,""); ++ ++DEF_ORDINARY("PARSE-ERROR",sLparse_error,LISP,""); ++ ++DEF_ORDINARY("PRINT-NOT-READABLE",sLprint_not_readable,LISP,""); ++ ++DEF_ORDINARY("READER-ERROR",sLreader_error,LISP,""); ++DEF_ORDINARY("PATHNAME-ERROR",sLpathname_error,SI,""); ++ ++DEF_ORDINARY("STORAGE-CONDITION",sLstorage_condition,LISP,""); ++ ++DEF_ORDINARY("WARNING",sLwarning,LISP,""); ++DEF_ORDINARY("SIMPLE-WARNING",sLsimple_warning,LISP,""); ++DEF_ORDINARY("STYLE-WARNING",sLstyle_warning,LISP,""); ++ + void +-gcl_init_error(void) +-{ +- null_string = make_simple_string(""); +- enter_mark_origin(&null_string); ++gcl_init_error(void) { ++ null_string = make_simple_string(""); ++ enter_mark_origin(&null_string); + } +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -1501,14 +1501,12 @@ read_fasl_vector(object in) + object d; + int tem; + if (((tem=getc(((FILE *)in->sm.sm_fp))) == EOF) && feof(((FILE *)in->sm.sm_fp))) +- { d = coerce_to_pathname(in); +- d = make_pathname(d->pn.pn_host, +- d->pn.pn_device, +- d->pn.pn_directory, +- d->pn.pn_name, +- make_simple_string("data"), +- d->pn.pn_version); +- d = coerce_to_namestring(d); ++ { char *pf; ++ coerce_to_filename(in,FN1); ++ for (pf=FN1+strlen(FN1);pf>FN1 && pf[-1]!='.';pf--); ++ if (pf==FN1) {pf=FN1+strlen(FN1);*pf++='.';} ++ snprintf(pf,sizeof(FN1)-(pf-FN1),"data"); ++ d=make_simple_string(FN1); + in = open_stream(d,smm_input,Cnil,Cnil); + if (in == Cnil) + FEerror("Can't open file ~s",1,d); +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -138,7 +138,7 @@ void + end_of_stream(strm) + object strm; + { +- FEerror("Unexpected end of ~S.", 1, strm); ++ END_OF_FILE(strm); + } + + /* +@@ -167,6 +167,7 @@ BEGIN: + case smm_probe: + return(FALSE); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -223,6 +224,7 @@ BEGIN: + case smm_probe: + return(FALSE); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -270,6 +272,7 @@ BEGIN: + case smm_socket: + return (sLcharacter); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -341,220 +344,208 @@ cannot_create(object); + Fn is a namestring. + */ + object +-open_stream(fn, smm, if_exists, if_does_not_exist) +-object fn; +-enum smmode smm; +-object if_exists, if_does_not_exist; +-{ +- object x; +- FILE *fp=NULL; +- char fname[PATH_MAX]; +- object unzipped = 0; +- vs_mark; ++open_stream(object fn,enum smmode smm, object if_exists, object if_does_not_exist) { + +-/* +- if (type_of(fn) != t_string) +- FEwrong_type_argument(sLstring, fn); +-*/ +- /* if (fn->st.st_fillp > BUFSIZ - 1) */ +- /* too_long_file_name(fn); */ +- /* for (i = 0; i < fn->st.st_fillp; i++) */ +- /* fname[i] = fn->st.st_self[i]; */ +- +- /* fname[i] = '\0'; */ +- coerce_to_filename(fn,fname); +- if (smm == smm_input || smm == smm_probe) { +- if(fname[0]=='|') +- fp = popen(fname+1,"r"); +- else +- fp = fopen_not_dir(fname, "r"); +- +- AGAIN: +- if (fp == NULL) { +- if (sSAallow_gzipped_fileA->s.s_dbind != sLnil) +- { +- static struct string st; +- char buf[256]; +- if (snprintf(buf,sizeof(buf),"%s.gz",fname)<=0) +- FEerror("Cannot write .gz filename",0); +- st.st_self=buf; +- st.st_dim=st.st_fillp=strlen(buf); +- set_type_of(&st,t_string); +- if (file_exists((object)&st)) { +- FILE *pp; +- int n; +- if (!(fp=tmpfile())) +- FEerror("Cannot create temporary file",0); +- if (snprintf(buf,sizeof(buf),"zcat %s.gz",fname)<=0) +- FEerror("Cannot write zcat pipe name",0); +- if (!(pp=popen(buf,"r"))) +- FEerror("Cannot open zcat pipe",0); +- while((n=fread(buf,1,sizeof(buf),pp))) +- if (!fwrite(buf,1,n,fp)) +- FEerror("Cannot write pipe output to temporary file",0); +- if (pclose(pp)<0) +- FEerror("Cannot close zcat pipe",0); +- if (fseek(fp,0,SEEK_SET)) +- FEerror("Cannot rewind temporary file\n",0); +- goto AGAIN; +- } +- } +- +-/* fp = fopen_not_dir(buf,"r"); */ +-/* if (fp) */ +-/* { */ +-/* #ifdef NO_MKSTEMP */ +-/* char *tmp; */ +-/* #else */ +-/* char tmp[200]; */ +-/* #endif */ +-/* char command [500]; */ +-/* fclose(fp); */ +-/* #ifdef NO_MKSTEMP */ +-/* tmp = tmpnam(0); */ +-/* #else */ +-/* snprintf(tmp,sizeof(tmp),"uzipXXXXXX"); */ +- /* mkstemp(tmp); */ /* fixme: catch errors */ +-/* #endif */ +-/* unzipped = make_simple_string(tmp); */ +-/* sprintf(command,"gzip -dc %s > %s",buf,tmp); */ +-/* fp = 0; */ +-/* if (0 == system(command)) */ +-/* { */ +-/* fp = fopen_not_dir(tmp,"r"); */ +-/* if (fp) */ +-/* goto AGAIN; */ +-/* /\* should not get here *\/ */ +-/* else { unlink(tmp);}} */ +-/* }} */ +- if (if_does_not_exist == sKerror) +- cannot_open(fn); +- else if (if_does_not_exist == sKcreate) { +- fp = fopen_not_dir(fname, "w"); +- if (fp == NULL) +- cannot_create(fn); +- fclose(fp); +- fp = fopen_not_dir(fname, "r"); +- if (fp == NULL) +- cannot_open(fn); +- } else if (if_does_not_exist == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", +- 1, if_does_not_exist); +- } +- } else if (smm == smm_output || smm == smm_io) { +- if (if_exists == sKnew_version && if_does_not_exist == sKcreate) +- goto CREATE; +- fp = fopen_not_dir(fname, "r"); +- if (fp != NULL) { +- fclose(fp); +- if (if_exists == sKerror) +- FEerror("The file ~A already exists.", 1, fn); +- else if (if_exists == sKrename) { +- if (smm == smm_output) +- fp = backup_fopen(fname, "w"); +- else +- fp = backup_fopen(fname, "w+"); +- if (fp == NULL) +- cannot_create(fn); +- } else if (if_exists == sKrename_and_delete || +- if_exists == sKnew_version || +- if_exists == sKsupersede) { +- if (smm == smm_output) +- fp = fopen_not_dir(fname, "w"); +- else +- fp = fopen_not_dir(fname, "w+"); +- if (fp == NULL) +- cannot_create(fn); +- } else if (if_exists == sKoverwrite) { +- fp = fopen_not_dir(fname, "r+"); +- if (fp == NULL) +- cannot_open(fn); +- } else if (if_exists == sKappend) { +- if (smm == smm_output) +- fp = fopen_not_dir(fname, "a"); +- else +- fp = fopen_not_dir(fname, "a+"); +- if (fp == NULL) +- FEerror("Cannot append to the file ~A.",1,fn); +- } else if (if_exists == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-EXISTS option.", +- 1, if_exists); +- } else { +- if (if_does_not_exist == sKerror) +- FEerror("The file ~A does not exist.", 1, fn); +- else if (if_does_not_exist == sKcreate) { +- CREATE: +- if (smm == smm_output) +- { +- if(fname[0]=='|') +- fp = popen(fname+1,"w"); +- else +- fp = fopen_not_dir(fname, "w"); +- } +- else +- fp = fopen_not_dir(fname, "w+"); +- if (fp == NULL) +- cannot_create(fn); +- } else if (if_does_not_exist == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", +- 1, if_does_not_exist); +- } ++ object x; ++ FILE *fp=NULL; ++ vs_mark; ++ ++ coerce_to_filename(fn,FN1); ++ if (smm == smm_input || smm == smm_probe) { ++ if(FN1[0]=='|') ++ fp = popen(FN1+1,"r"); ++ else ++ fp = fopen_not_dir(FN1, "r"); ++ ++ if ((fp == NULL) && ++ (sSAallow_gzipped_fileA->s.s_dbind != sLnil)) { ++ union lispunion st; ++ char buf[256]; ++ if (snprintf(buf,sizeof(buf),"%s.gz",FN1)<=0) ++ FEerror("Cannot write .gz filename",0); ++ st.st.st_self=buf; ++ st.st.st_dim=st.st.st_fillp=strlen(buf); ++ set_type_of(&st,t_string); ++ if (fSstat((object)&st)!=Cnil) { ++ FILE *pp; ++ int n; ++ if (!(fp=tmpfile())) ++ FEerror("Cannot create temporary file",0); ++ if (snprintf(buf,sizeof(buf),"zcat %s.gz",FN1)<=0) ++ FEerror("Cannot write zcat pipe name",0); ++ if (!(pp=popen(buf,"r"))) ++ FEerror("Cannot open zcat pipe",0); ++ while((n=fread(buf,1,sizeof(buf),pp))) ++ if (!fwrite(buf,1,n,fp)) ++ FEerror("Cannot write pipe output to temporary file",0); ++ if (pclose(pp)<0) ++ FEerror("Cannot close zcat pipe",0); ++ if (fseek(fp,0,SEEK_SET)) ++ FEerror("Cannot rewind temporary file\n",0); ++ } ++ } ++ if (fp == NULL) { ++ if (if_does_not_exist == sKerror) ++ cannot_open(fn); ++ else if (if_does_not_exist == sKcreate) { ++ fp = fopen_not_dir(FN1, "w"); ++ if (fp == NULL) ++ cannot_create(fn); ++ fclose(fp); ++ fp = fopen_not_dir(FN1, "r"); ++ if (fp == NULL) ++ cannot_open(fn); ++ } else if (if_does_not_exist == Cnil) ++ return(Cnil); ++ else ++ FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", ++ 1, if_does_not_exist); ++ } ++ } else if (smm == smm_output || smm == smm_io) { ++ if (FN1[0] == '|') ++ fp = NULL; ++ else ++ fp = fopen_not_dir(FN1, "r"); ++ if (fp != NULL) { ++ fclose(fp); ++ if (if_exists == sKerror) ++ FILE_ERROR(fn,"File exists"); ++ else if (if_exists == sKrename) { ++ massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0); ++ massert(!rename(FN1,FN2)); ++ if (smm == smm_output) ++ fp = fopen(FN1, "w"); ++ else ++ fp = fopen(FN1, "w+"); ++ if (fp == NULL) ++ cannot_create(fn); ++ } else if (if_exists == sKrename_and_delete || ++ if_exists == sKnew_version || ++ if_exists == sKsupersede) { ++ if (smm == smm_output) ++ fp = fopen_not_dir(FN1, "w"); ++ else ++ fp = fopen_not_dir(FN1, "w+"); ++ if (fp == NULL) ++ cannot_create(fn); ++ } else if (if_exists == sKoverwrite) { ++ fp = fopen_not_dir(FN1, "r+"); ++ if (fp == NULL) ++ cannot_open(fn); ++ } else if (if_exists == sKappend) { ++ if (smm == smm_output) ++ fp = fopen_not_dir(FN1, "a"); ++ else ++ fp = fopen_not_dir(FN1, "a+"); ++ if (fp == NULL) ++ FEerror("Cannot append to the file ~A.",1,fn); ++ } else if (if_exists == Cnil) ++ return(Cnil); ++ else ++ FEerror("~S is an illegal IF-EXISTS option.", ++ 1, if_exists); ++ } else { ++ if (if_does_not_exist == sKerror) ++ FILE_ERROR(fn,"The file does not exist"); ++ else if (if_does_not_exist == sKcreate) { ++ if (smm == smm_output) { ++ if(FN1[0]=='|') ++ fp = popen(FN1+1,"w"); ++ else ++ fp = fopen_not_dir(FN1, "w"); + } else +- error("illegal stream mode"); +- x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm; +- x->sm.sm_fp = fp; ++ fp = fopen_not_dir(FN1, "w+"); ++ if (fp == NULL) ++ cannot_create(fn); ++ } else if (if_does_not_exist == Cnil) ++ return(Cnil); ++ else ++ FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", ++ 1, if_does_not_exist); ++ } ++ } else ++ FEerror("Illegal open mode for ~S.",1,fn); ++ ++ vs_push(make_simple_string(FN1)); ++ x = alloc_object(t_stream); ++ x->sm.sm_mode = (short)smm; ++ x->sm.sm_fp = fp; ++ x->sm.sm_buffer = 0; ++ x->sm.sm_object0 = sLcharacter; ++ x->sm.sm_object1 = vs_head; ++ x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_flags=0; ++ vs_push(x); ++ ++ setup_stream_buffer(x); ++ vs_reset; ++ ++ if (smm==smm_probe) ++ close_stream(x); ++ ++ return(x); + +- x->sm.sm_buffer = 0; +- x->sm.sm_object0 = (unzipped ? make_cons(sSAallow_gzipped_fileA,unzipped) : sLcharacter); +- x->sm.sm_object1 = fn; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; +- vs_push(x); +- setup_stream_buffer(x); +- vs_reset; +- return(x); + } + + static void + gclFlushSocket(object); + ++DEFUN_NEW("OPEN-INT",object,fSopen_int,SI,8,8,NONE,OO,OO,OO,OO, ++ (object fn,object direction,object element_type,object if_exists, ++ object iesp,object if_does_not_exist,object idnesp, ++ object external_format),"") { ++ ++ enum smmode smm=0; ++ vs_mark; ++ object strm,filename; ++ ++ filename=fn; ++ if (direction == sKinput) { ++ smm = smm_input; ++ if (idnesp==Cnil) ++ if_does_not_exist = sKerror; ++ } else if (direction == sKoutput) { ++ smm = smm_output; ++ if (iesp==Cnil) ++ if_exists = sKnew_version; ++ if (idnesp==Cnil) { ++ if (if_exists == sKoverwrite || ++ if_exists == sKappend) ++ if_does_not_exist = sKerror; ++ else ++ if_does_not_exist = sKcreate; ++ } ++ } else if (direction == sKio) { ++ smm = smm_io; ++ if (iesp==Cnil) ++ if_exists = sKnew_version; ++ if (idnesp==Cnil) { ++ if (if_exists == sKoverwrite || ++ if_exists == sKappend) ++ if_does_not_exist = sKerror; ++ else ++ if_does_not_exist = sKcreate; ++ } ++ } else if (direction == sKprobe) { ++ smm = smm_probe; ++ if (idnesp==Cnil) ++ if_does_not_exist = Cnil; ++ } else ++ FEerror("~S is an illegal DIRECTION for OPEN.", 1, direction); ++ strm = open_stream(filename, smm, if_exists, if_does_not_exist); ++ if (type_of(strm) == t_stream) { ++ strm->sm.sm_object0 = element_type; ++ strm->sm.sm_object1 = fn; ++ } ++ vs_reset; ++ RETURN1(strm); ++} + + DEFUN_NEW("OPEN-STREAM-P",object,fLopen_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + check_type_stream(&x); + +- switch(x->sm.sm_mode) { +- case smm_output: +- case smm_input: +- case smm_io: +- case smm_probe: +- case smm_socket: +- case smm_string_input: +- case smm_string_output: +- return x->d.tt==1 ? Cnil : Ct; +- case smm_synonym: +- return FFN(fLopen_stream_p)(symbol_value(x->sm.sm_object0)); +- case smm_broadcast: +- case smm_concatenated: +- for (x=x->sm.sm_object0;!endp(x);x=x->c.c_cdr) +- if (!FFN(fLopen_stream_p)(x)) +- return Cnil; +- return Ct; +- case smm_two_way: +- case smm_echo: +- if (FFN(fLopen_stream_p)(STREAM_INPUT_STREAM(x))==Cnil) +- return Cnil; +- return FFN(fLopen_stream_p)(STREAM_OUTPUT_STREAM(x)); +- default: +- error("illegal stream mode"); +- return Cnil; +- } ++ return GET_STREAM_FLAG(x,gcl_sm_closed) ? Cnil : Ct; + + } + /* +@@ -562,94 +553,132 @@ DEFUN_NEW("OPEN-STREAM-P",object,fLopen_ + The abort_flag is not used now. + */ + void +-close_stream(strm) +-object strm; +-/*bool abort_flag; */ /* Not used now! */ +-{ +- object x; ++close_stream(object strm) { + +-BEGIN: +- strm->d.tt=1; ++ object x; + +- switch (strm->sm.sm_mode) { +- case smm_output: +- if (strm->sm.sm_fp == stdout) +- FEerror("Cannot close the standard output.", 0); +- if (strm->sm.sm_fp == NULL) break; +- fflush(strm->sm.sm_fp); +- deallocate_stream_buffer(strm); +- fclose(strm->sm.sm_fp); +- strm->sm.sm_fp = NULL; +- break; ++ if (FFN(fLopen_stream_p)(strm)==Cnil) ++ return; + ++ switch (strm->sm.sm_mode) { ++ case smm_output: ++ if (strm->sm.sm_fp == stdout) ++ FEerror("Cannot close the standard output.", 0); ++ fflush(strm->sm.sm_fp); ++ deallocate_stream_buffer(strm); ++ fclose(strm->sm.sm_fp); ++ strm->sm.sm_fp = NULL; ++ strm->sm.sm_fd = -1; ++ break; + +- case smm_socket: +- if (SOCKET_STREAM_FD(strm) < 2) +- emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); +- else { ++ case smm_socket: ++ if (SOCKET_STREAM_FD(strm) < 2) ++ emsg("tried Closing %d ! as socket \n",SOCKET_STREAM_FD(strm)); ++ else { + #ifdef HAVE_NSOCKET +- if (GET_STREAM_FLAG(strm,gcl_sm_output)) +- { +- gclFlushSocket(strm); +- /* there are two for one fd so close only one */ +- tcpCloseSocket(SOCKET_STREAM_FD(strm)); +- } ++ if (GET_STREAM_FLAG(strm,gcl_sm_output)) { ++ gclFlushSocket(strm); ++ /* there are two for one fd so close only one */ ++ tcpCloseSocket(SOCKET_STREAM_FD(strm)); ++ } + #endif +- SOCKET_STREAM_FD(strm)=-1; +- } ++ SOCKET_STREAM_FD(strm)=-1; ++ } + +- case smm_input: +- if (strm->sm.sm_fp == stdin) +- FEerror("Cannot close the standard input.", 0); +- +- case smm_io: +- case smm_probe: +- if (strm->sm.sm_fp == NULL) break; +- deallocate_stream_buffer(strm); +- if (strm->sm.sm_object1 && +- type_of(strm->sm.sm_object1)==t_string && +- strm->sm.sm_object1->st.st_self[0] =='|') +- pclose(strm->sm.sm_fp); +- else +- fclose(strm->sm.sm_fp); +- strm->sm.sm_fp = NULL; +- if (strm->sm.sm_object0 && +- type_of(strm->sm.sm_object0 ) == t_cons && +- Mcar(strm->sm.sm_object0 ) == sSAallow_gzipped_fileA) +- fLdelete_file(Mcdr(strm->sm.sm_object0)); +- break; ++ case smm_input: ++ if (strm->sm.sm_fp == stdin) ++ FEerror("Cannot close the standard input.", 0); + +- case smm_synonym: +- strm = symbol_value(strm->sm.sm_object0); +- if (type_of(strm) != t_stream) +- FEwrong_type_argument(sLstream, strm); +- goto BEGIN; ++ case smm_io: ++ case smm_probe: ++ deallocate_stream_buffer(strm); ++ if (strm->sm.sm_object1 && ++ type_of(strm->sm.sm_object1)==t_string && ++ strm->sm.sm_object1->st.st_self[0] =='|') ++ pclose(strm->sm.sm_fp); ++ else ++ fclose(strm->sm.sm_fp); ++ strm->sm.sm_fp = NULL; ++ strm->sm.sm_fd = -1; ++ if (strm->sm.sm_object0 && ++ type_of(strm->sm.sm_object0 )==t_cons && ++ Mcar(strm->sm.sm_object0)==sSAallow_gzipped_fileA) ++ ifuncall1(sLdelete_file,Mcdr(strm->sm.sm_object0)); ++ break; + +- case smm_broadcast: +- for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) +- close_stream(x->c.c_car); +- break; ++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++ TYPE_ERROR(strm,sLstream); ++ close_stream(strm); ++ break; + +- case smm_concatenated: +- for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) +- close_stream(x->c.c_car); +- break; ++ case smm_broadcast: ++ case smm_concatenated: ++ for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) ++ close_stream(x->c.c_car); ++ break; + +- case smm_two_way: +- case smm_echo: +- close_stream(STREAM_INPUT_STREAM(strm)); +- close_stream(STREAM_OUTPUT_STREAM(strm)); +- break; ++ case smm_two_way: ++ case smm_echo: ++ close_stream(STREAM_INPUT_STREAM(strm)); ++ close_stream(STREAM_OUTPUT_STREAM(strm)); ++ break; + +- case smm_string_input: +- break; /* There is nothing to do. */ ++ case smm_string_input: ++ case smm_string_output: ++ break; + +- case smm_string_output: +- break; /* There is nothing to do. */ ++ default: ++ error("Illegal stream mode"); ++ } ++ ++ SET_STREAM_FLAG(strm,gcl_sm_closed,1); ++ ++} ++ ++DEFUN_NEW("INTERACTIVE-STREAM-P",object,fLinteractive_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object strm),"") { ++ ++ check_type_stream(&strm); ++ ++ switch (strm->sm.sm_mode) { ++ case smm_output: ++ case smm_input: ++ case smm_io: ++ case smm_probe: ++ if ((strm->sm.sm_fp == stdin) || ++ (strm->sm.sm_fp == stdout) || ++ (strm->sm.sm_fp == stderr)) ++ return Ct; ++ return Cnil; ++ break; ++ case smm_file_synonym: ++ case smm_synonym: ++ strm = symbol_value(strm->sm.sm_object0); ++ if (type_of(strm) != t_stream) ++ FEwrong_type_argument(sLstream, strm); ++ break; ++ ++ case smm_broadcast: ++ case smm_concatenated: ++ if (( consp(strm->sm.sm_object0) ) && ++ ( type_of(strm->sm.sm_object0->c.c_car) == t_stream )) ++ strm=strm->sm.sm_object0->c.c_car; ++ else ++ return Cnil; ++ break; ++ ++ case smm_two_way: ++ case smm_echo: ++ strm=STREAM_INPUT_STREAM(strm); ++ break; ++ default: ++ return Cnil; ++ } ++ ++ return Cnil; + +- default: +- error("illegal stream mode"); +- } + } + + object +@@ -665,6 +694,7 @@ object istrm, ostrm; + STREAM_INPUT_STREAM(strm) = istrm; + STREAM_OUTPUT_STREAM(strm) = ostrm; + strm->sm.sm_int0 = strm->sm.sm_int1 = 0; ++ strm->sm.sm_flags=0; + return(strm); + } + +@@ -694,6 +724,7 @@ int istart, iend; + strm->sm.sm_object1 = OBJNULL; + STRING_INPUT_STREAM_NEXT(strm)= istart; + STRING_INPUT_STREAM_END(strm)= iend; ++ strm->sm.sm_flags=0; + return(strm); + } + +@@ -729,6 +760,7 @@ int line_length; + STRING_STREAM_STRING(strm) = strng; + strm->sm.sm_object1 = OBJNULL; + strm->sm.sm_int0 = STREAM_FILE_COLUMN(strm) = 0; ++ strm->sm.sm_flags=0; + vs_reset; + return(strm); + } +@@ -782,6 +814,7 @@ BEGIN: + /* strm->sm.sm_int0++; */ + return(c==EOF ? c : (c&0377)); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -884,6 +917,7 @@ BEGIN: + /* --strm->sm.sm_int0; */ /* use ftell now for position */ + break; + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -985,6 +1019,7 @@ BEGIN: + + break; + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1095,6 +1130,7 @@ BEGIN: + #endif + closed_stream(strm); + break; ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1183,6 +1219,7 @@ BEGIN: + case smm_probe: + return(FALSE); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + check_stream(strm); +@@ -1308,6 +1345,7 @@ BEGIN: + #endif + return TRUE; + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1363,6 +1401,7 @@ BEGIN: + case smm_string_output: + return(STRING_STREAM_STRING(strm)->st.st_fillp); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1412,6 +1451,7 @@ BEGIN: + } + return(0); + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1448,6 +1488,7 @@ BEGIN: + + + ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1487,6 +1528,7 @@ BEGIN: + case smm_two_way: + strm=STREAM_OUTPUT_STREAM(strm); + goto BEGIN; ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1553,6 +1595,22 @@ load(const char *s) { + + + ++static int ++file_synonym_stream_p(object x) { ++ switch(x->sm.sm_mode) { ++ case smm_input: ++ case smm_output: ++ case smm_io: ++ case smm_probe: ++ case smm_file_synonym: ++ return 1; ++ case smm_synonym: ++ return file_synonym_stream_p(x->sm.sm_object0->s.s_dbind); ++ default: ++ return 0; ++ } ++} ++ + LFD(Lmake_synonym_stream)() + { + object x; +@@ -1560,12 +1618,13 @@ LFD(Lmake_synonym_stream)() + check_arg(1); + check_type_sym(&vs_base[0]); + x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm_synonym; ++ x->sm.sm_mode = file_synonym_stream_p(vs_base[0]) ? (short)smm_file_synonym : (short)smm_synonym; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_flags=0; + vs_base[0] = x; + } + +@@ -1589,6 +1648,7 @@ LFD(Lmake_broadcast_stream)() + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_flags=0; + vs_base[0] = x; + } + +@@ -1612,6 +1672,7 @@ LFD(Lmake_concatenated_stream)() + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_flags=0; + vs_base[0] = x; + } + +@@ -1700,6 +1761,38 @@ LFD(siLoutput_stream_string)() + vs_base[0] = vs_base[0]->sm.sm_object0; + } + ++DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && ++ (x->sm.sm_mode==smm_input || x->sm.sm_mode==smm_output || x->sm.sm_mode==smm_io || x->sm.sm_mode==smm_probe) ++ ? Ct : Cnil); ++} ++ ++DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && (x->sm.sm_mode==smm_file_synonym || x->sm.sm_mode==smm_synonym) ? Ct : Cnil); ++} ++ ++DEFUN_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_input && x->sm.sm_fp && isatty(fileno((FILE *)x->sm.sm_fp)) ? Ct : Cnil); ++} ++ ++DEFUN_NEW("BROADCAST-STREAM-P",object,fSbroadcast_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_broadcast ? Ct : Cnil); ++} ++ ++DEFUN_NEW("ECHO-STREAM-P",object,fSecho_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_echo ? Ct : Cnil); ++} ++ ++DEFUN_NEW("TWO-WAY-STREAM-P",object,fStwo_way_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_two_way ? Ct : Cnil); ++} ++ ++DEFUN_NEW("CONCATENATED-STREAM-P",object,fSconcatenated_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_concatenated ? Ct : Cnil); ++} ++ ++ ++ + LFD(Lstreamp)() + { + check_arg(1); +@@ -1747,54 +1840,6 @@ LFD(Lstream_element_type)() + @(return Ct) + @) + +-@(static defun open (filename +- &key (direction sKinput) +- (element_type sLcharacter) +- (if_exists Cnil iesp) +- (if_does_not_exist Cnil idnesp) +- &aux strm) +- enum smmode smm=0; +-@ +- check_type_or_pathname_string_symbol_stream(&filename); +- filename = coerce_to_namestring(filename); +- if (direction == sKinput) { +- smm = smm_input; +- if (!idnesp) +- if_does_not_exist = sKerror; +- } else if (direction == sKoutput) { +- smm = smm_output; +- if (!iesp) +- if_exists = sKnew_version; +- if (!idnesp) { +- if (if_exists == sKoverwrite || +- if_exists == sKappend) +- if_does_not_exist = sKerror; +- else +- if_does_not_exist = sKcreate; +- } +- } else if (direction == sKio) { +- smm = smm_io; +- if (!iesp) +- if_exists = sKnew_version; +- if (!idnesp) { +- if (if_exists == sKoverwrite || +- if_exists == sKappend) +- if_does_not_exist = sKerror; +- else +- if_does_not_exist = sKcreate; +- } +- } else if (direction == sKprobe) { +- smm = smm_probe; +- if (!idnesp) +- if_does_not_exist = Cnil; +- } else +- FEerror("~S is an illegal DIRECTION for OPEN.", +- 1, direction); +- strm = open_stream(filename, smm, if_exists, if_does_not_exist); +- if (type_of(strm) == t_stream) +- strm->sm.sm_object0 = element_type; +- @(return strm) +-@) + + @(defun file_position (file_stream &o position) + int i=0; +@@ -1838,175 +1883,72 @@ object sLAload_pathnameA; + DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,""); + DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,""); + +-@(static defun load (pathname +- &key (verbose `symbol_value(sLAload_verboseA)`) +- print +- (if_does_not_exist sKerror) +- &aux pntype fasl_filename lsp_filename filename +- defaults strm stdoutput x +- package) +- bds_ptr old_bds_top; +- int i; +- object strm1; +-@ +- check_type_or_pathname_string_symbol_stream(&pathname); +- pathname = coerce_to_pathname(pathname); +- defaults = symbol_value(Vdefault_pathname_defaults); +- defaults = coerce_to_pathname(defaults); +- pathname = merge_pathnames(pathname, defaults, sKnewest); +- pntype = pathname->pn.pn_type; +- filename = coerce_to_namestring(pathname); +- if (user_match(filename->st.st_self,filename->st.st_fillp)) +- @(return Cnil) +- old_bds_top=bds_top; +- if (pntype == Cnil || pntype == sKwild || +- (type_of(pntype) == t_string && +-#ifdef UNIX +- string_eq(pntype, FASL_string))) { +-#endif +-#ifdef AOSVS ++DEFUN_NEW("LOAD-STREAM",object,fSload_stream,SI,2,2,NONE,OO,OO,OO,OO,(object strm,object print),"") { + +-#endif +- pathname->pn.pn_type = FASL_string; +- fasl_filename = coerce_to_namestring(pathname); +- } +- if (pntype == Cnil || pntype == sKwild || +- (type_of(pntype) == t_string && +-#ifdef UNIX +- string_eq(pntype, LSP_string))) { +-#endif +-#ifdef AOSVS ++ object x; + +-#endif +- pathname->pn.pn_type = LSP_string; +- lsp_filename = coerce_to_namestring(pathname); +- } +- if (fasl_filename != Cnil && file_exists(fasl_filename)) { +- if (verbose != Cnil) { +- SETUP_PRINT_DEFAULT(fasl_filename); +- if (file_column(PRINTstream) != 0) +- write_str("\n"); +- write_str("Loading "); +- PRINTescape = FALSE; +- write_object(fasl_filename, 0); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- package = symbol_value(sLApackageA); +- bds_bind(sLApackageA, package); +- bds_bind(sLAload_pathnameA,fasl_filename); +- if (sSAcollect_binary_modulesA->s.s_dbind==Ct) { +- object _x=sSAbinary_modulesA->s.s_dbind; +- object _y=Cnil; +- while (_x!=Cnil) { +- _y=_x; +- _x=_x->c.c_cdr; +- } +- if (_y==Cnil) +- sSAbinary_modulesA->s.s_dbind=make_cons(fasl_filename,Cnil); +- else +- _y->c.c_cdr=make_cons(fasl_filename,Cnil); +- } +- i = fasload(fasl_filename); +- if (print != Cnil) { +- SETUP_PRINT_DEFAULT(Cnil); +- vs_top = PRINTvs_top; +- if (file_column(PRINTstream) != 0) +- write_str("\n"); +- write_str("Fasload successfully ended."); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- bds_unwind(old_bds_top); +- if (verbose != Cnil) { +- SETUP_PRINT_DEFAULT(fasl_filename); +- if (file_column(PRINTstream) != 0) +- write_str("\n"); +- write_str("Finished loading "); +- PRINTescape = FALSE; +- write_object(fasl_filename, 0); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- @(return `make_fixnum(i)`) +- } +- if (lsp_filename != Cnil && file_exists(lsp_filename)) { +- filename = lsp_filename; +- } +- if (if_does_not_exist != Cnil) +- if_does_not_exist = sKerror; +- strm1 = strm +- = open_stream(filename, smm_input, Cnil, if_does_not_exist); +- if (strm == Cnil) +- @(return Cnil) +- if (verbose != Cnil) { +- SETUP_PRINT_DEFAULT(filename); +- if (file_column(PRINTstream) != 0) +- write_str("\n"); +- write_str("Loading "); +- PRINTescape = FALSE; +- write_object(filename, 0); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- package = symbol_value(sLApackageA); +- bds_bind(sLAload_pathnameA,pathname); +- bds_bind(sLApackageA, package); +- bds_bind(sLAstandard_inputA, strm); +- frs_push(FRS_PROTECT, Cnil); +- if (nlj_active) { +- close_stream(strm1); +- nlj_active = FALSE; +- frs_pop(); +- bds_unwind(old_bds_top); +- unwind(nlj_fr, nlj_tag); +- } +- for (;;) { +- preserving_whitespace_flag = FALSE; +- detect_eos_flag = TRUE; +- x = read_object_non_recursive(strm); +- if (x == OBJNULL) +- break; +- { +- object *base = vs_base, *top = vs_top, *lex = lex_env; +- object xx; +- +- lex_new(); +- eval(x); +- xx = vs_base[0]; +- lex_env = lex; +- vs_top = top; +- vs_base = base; +- x = xx; +- } +- if (print != Cnil) { +- SETUP_PRINT_DEFAULT(x); +- write_object(x, 0); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- } +- close_stream(strm); +- frs_pop(); +- bds_unwind(old_bds_top); +- if (verbose != Cnil) { +- SETUP_PRINT_DEFAULT(filename); +- if (file_column(PRINTstream) != 0) +- write_str("\n"); +- write_str("Finished loading "); +- PRINTescape = FALSE; +- write_object(filename, 0); +- write_str("\n"); +- CLEANUP_PRINT_DEFAULT; +- flush_stream(PRINTstream); +- } +- @(return Ct) +-@) ++ for (;;) { ++ preserving_whitespace_flag = FALSE; ++ detect_eos_flag = TRUE; ++ x = read_object_non_recursive(strm); ++ if (x == OBJNULL) ++ break; ++ { ++ object *base = vs_base, *top = vs_top, *lex = lex_env; ++ object xx; ++ ++ lex_new(); ++ eval(x); ++ xx = vs_base[0]; ++ lex_env = lex; ++ vs_top = top; ++ vs_base = base; ++ x = xx; ++ } ++ if (print != Cnil) { ++ SETUP_PRINT_DEFAULT(x); ++ write_object(x, 0); ++ write_str("\n"); ++ CLEANUP_PRINT_DEFAULT; ++ flush_stream(PRINTstream); ++ } ++ } ++ ++ RETURN1(Ct); ++ ++} ++ ++DEFUN_NEW("LOAD-FASL",object,fSload_fasl,SI,2,2,NONE,OO,OO,OO,OO,(object fasl_filename,object print),"") { ++ ++ int i; ++ ++ if (sSAcollect_binary_modulesA->s.s_dbind==Ct) { ++ object _x=sSAbinary_modulesA->s.s_dbind; ++ object _y=Cnil; ++ while (_x!=Cnil) { ++ _y=_x; ++ _x=_x->c.c_cdr; ++ } ++ if (_y==Cnil) ++ sSAbinary_modulesA->s.s_dbind=make_cons(fasl_filename,Cnil); ++ else ++ _y->c.c_cdr=make_cons(fasl_filename,Cnil); ++ } ++ i = fasload(fasl_filename); ++ if (print != Cnil) { ++ SETUP_PRINT_DEFAULT(Cnil); ++ vs_top = PRINTvs_top; ++ if (file_column(PRINTstream) != 0) ++ write_str("\n"); ++ write_str(";; Fasload successfully ended."); ++ write_str("\n"); ++ CLEANUP_PRINT_DEFAULT; ++ flush_stream(PRINTstream); ++ } ++ ++ RETURN1(make_fixnum(i)); ++ ++} + + static void + FFN(siLget_string_input_stream_index)() +@@ -2018,9 +1960,6 @@ FFN(siLget_string_input_stream_index)() + vs_base[0] = make_fixnum(STRING_INPUT_STREAM_NEXT(vs_base[0])); + } + +-DEFUN_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_input && x->sm.sm_fp && isatty(fileno((FILE *)x->sm.sm_fp)) ? Ct : Cnil); +-} + + LFD(siLmake_string_output_stream_from_string)() + { +@@ -2038,6 +1977,7 @@ LFD(siLmake_string_output_stream_from_st + strm->sm.sm_object1 = OBJNULL; + /* strm->sm.sm_int0 = strng->st.st_fillp; */ + STREAM_FILE_COLUMN(strm) = 0; ++ strm->sm.sm_flags=0; + vs_base[0] = strm; + } + +@@ -2071,14 +2011,14 @@ static void + cannot_open(fn) + object fn; + { +- FEerror("Cannot open the file ~A.", 1, fn); ++ FILE_ERROR(fn,"Cannot open"); + } + + static void + cannot_create(fn) + object fn; + { +- FEerror("Cannot create the file ~A.", 1, fn); ++ FILE_ERROR(fn,"Cannot create"); + } + + static void +@@ -2141,6 +2081,7 @@ int out; + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + switch (strm->sm.sm_mode){ ++ case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -2566,6 +2507,7 @@ gcl_init_file(void) + #endif + standard_input->sm.sm_int0 = 0; /* unused */ + standard_input->sm.sm_int1 = 0; /* unused */ ++ standard_input->sm.sm_flags=0; + + standard_output = alloc_object(t_stream); + standard_output->sm.sm_mode = (short)smm_output; +@@ -2578,18 +2520,20 @@ gcl_init_file(void) + #endif + standard_output->sm.sm_int0 = 0; /* unused */ + STREAM_FILE_COLUMN(standard_output) = 0; ++ standard_output->sm.sm_flags=0; + + terminal_io = standard + = make_two_way_stream(standard_input, standard_output); + enter_mark_origin(&terminal_io); + + x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm_synonym; ++ x->sm.sm_mode = (short)smm_file_synonym; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = sLAterminal_ioA; + x->sm.sm_object1 = OBJNULL; + x->sm.sm_int0 = x->sm.sm_int1 = 0; /* unused */ ++ x->sm.sm_flags=0; + standard_io = x; + enter_mark_origin(&standard_io); + +@@ -2597,7 +2541,9 @@ gcl_init_file(void) + + DEFVAR("*IGNORE-EOF-ON-TERMINAL-IO*",sSAignore_eof_on_terminal_ioA,SI,Cnil,""); + DEFVAR("*LOAD-PATHNAME*",sLAload_pathnameA,LISP,Cnil,""); ++DEFVAR("*LOAD-TRUENAME*",sSAload_truenameA,LISP,Cnil,""); + DEFVAR("*LOAD-VERBOSE*",sLAload_verboseA,LISP,Ct,""); ++DEFVAR("*LOAD-PRINT*",sLAload_printA,LISP,Cnil,""); + + DEF_ORDINARY("ABORT",sKabort,KEYWORD,""); + DEF_ORDINARY("APPEND",sKappend,KEYWORD,""); +@@ -2622,6 +2568,7 @@ DEF_ORDINARY("SUPERSEDE",sKsupersede,KEY + DEF_ORDINARY("VERBOSE",sKverbose,KEYWORD,""); + + ++DEF_ORDINARY("DELETE-FILE",sLdelete_file,LISP,""); + + + void +@@ -2673,13 +2620,9 @@ gcl_init_file_function() + make_function("STREAM-ELEMENT-TYPE", Lstream_element_type); + make_function("CLOSE", Lclose); + +- make_function("OPEN", Lopen); +- + make_function("FILE-POSITION", Lfile_position); + make_function("FILE-LENGTH", Lfile_length); + +- make_function("LOAD", Lload); +- + make_si_function("GET-STRING-INPUT-STREAM-INDEX", + siLget_string_input_stream_index); + make_si_function("MAKE-STRING-OUTPUT-STREAM-FROM-STRING", +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -57,7 +57,7 @@ mark_contblock(void *, int); + since this is more portable and faster lets use them --W. Schelter + These assume that DBEGIN is divisible by 32, or else we should have + #define Shamt(x) (((((int) x -DBEGIN) >> 2) & ~(~0 << 5))) +-*/ ++*/ + #define LOG_BITS_CHAR 3 + + #if CPTR_SIZE == 8 +@@ -72,7 +72,7 @@ void * + cb_in(void *p) { + struct contblock **cbpp; + int i; +- ++ + for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) { + if ((void *)*cbpp<=p && ((void *)(*cbpp)+(*cbpp)->cb_size) >p) + return *cbpp; +@@ -84,7 +84,7 @@ int + cb_print(void) { + struct contblock **cbpp; + int i; +- ++ + for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) + emsg("%lu at %p\n",(*cbpp)->cb_size,*cbpp); + emsg("%u blocks\n",i); +@@ -146,7 +146,7 @@ pageinfo_p(void *v) { + (!pi->next || (void *)pi->next>=v+(pi->type==t_contiguous ? pi->in_use : 1)*PAGESIZE); + + } +- ++ + static inline char + get_bit(char *v,struct pageinfo *pi,void *x) { + void *ve=CB_DATA_START(pi); +@@ -157,16 +157,6 @@ get_bit(char *v,struct pageinfo *pi,void + return (v[i]>>s)&0x1; + } + +-/* static inline void */ +-/* set_bit(char *v,struct pageinfo *pi,void *x) { */ +-/* void *ve=CB_DATA_START(pi); */ +-/* fixnum off=(x-ve)>>LOG_BYTES_CONTBLOCK,i=off>>LOG_BITS_CHAR,s=off&~(~0UL<>s)&0x1) + #define bit_set(v,i,s) (v[i]|=(1UL<d.st>=ngc_thresh && + (dp=alloc_contblock_no_gc(s,static_promotion_limit))) { +- ++ + *pp=memcpy(dp,p,s); + x->d.st=0; + + return; + +- } ++ } + + if (x && x->d.std.st++; + +@@ -460,7 +440,7 @@ mark_leaf_data(object x,void **pp,ufixnu + + static void mark_object1(object); + #define mark_object(x) if (marking(x)) mark_object1(x) +- ++ + static inline void + mark_object_address(object *o,int f) { + +@@ -468,7 +448,7 @@ mark_object_address(object *o,int f) { + static ufixnum lr; + + ufixnum p=page(o); +- ++ + if (lp!=p || !f) { + lp=p; + lr= +@@ -496,7 +476,7 @@ mark_object_array(object *o,object *oe) + + static void + mark_object1(object x) { +- ++ + fixnum i,j=0;/*FIXME*/ + + if (is_marked_or_free(x)) +@@ -567,7 +547,7 @@ mark_object1(object x) { + break; + + case t_array: +- MARK_LEAF_DATA(x,x->a.a_dims,sizeof(int)*x->a.a_rank); ++ MARK_LEAF_DATA(x,x->a.a_dims,sizeof(*x->a.a_dims)*x->a.a_rank); + + case t_vector: + case t_bitvector: +@@ -615,7 +595,7 @@ mark_object1(object x) { + x->v.v_self=p; + adjust_displaced(x,j); + } +- } ++ } + mark_object(x->v.v_displaced); + break; + +@@ -627,7 +607,7 @@ mark_object1(object x) { + mark_object(x->str.str_def); + if (x->str.str_self) + for (i=0,j=S_DATA(def)->length;istr.str_self,S_DATA(def)->size); + } +@@ -646,7 +626,8 @@ mark_object1(object x) { + MARK_LEAF_DATA(x,x->sm.sm_buffer,BUFSIZ); + } + break; +- ++ ++ case smm_file_synonym: + case smm_synonym: + mark_object(x->sm.sm_object0); + break; +@@ -676,7 +657,7 @@ mark_object1(object x) { + error("mark stream botch"); + } + break; +- ++ + case t_random: + MARK_LEAF_DATA_ALIGNED(x,x->rnd.rnd_state._mp_seed->_mp_d,x->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE,MP_LIMB_SIZE); + break; +@@ -700,6 +681,7 @@ mark_object1(object x) { + mark_object(x->pn.pn_name); + mark_object(x->pn.pn_type); + mark_object(x->pn.pn_version); ++ mark_object(x->pn.pn_namestring); + break; + + case t_closure: +@@ -854,24 +836,6 @@ mark_phase(void) { + } + #endif + +- /* +- if (what_to_collect != t_symbol && +- (int)what_to_collect < (int)t_contiguous) { +- */ +- +- /* {int size; */ +- +- /* for (pp = pack_pointer; pp != NULL; pp = pp->p_link) { */ +- /* size = pp->p_internal_size; */ +- /* if (pp->p_internal != NULL) */ +- /* for (i = 0; i < size; i++) */ +- /* mark_object(pp->p_internal[i]); */ +- /* size = pp->p_external_size; */ +- /* if (pp->p_external != NULL) */ +- /* for (i = 0; i < size; i++) */ +- /* mark_object(pp->p_external[i]); */ +- /* }} */ +- + /* mark the c stack */ + #ifndef N_RECURSION_REQD + #define N_RECURSION_REQD 2 +@@ -979,15 +943,15 @@ mark_c_stack(jmp_buf env1, int n, void ( + extern void * __libc_ia64_register_backing_store_base; + void * bst=GC_save_regs_in_stack(); + void * bsb=__libc_ia64_register_backing_store_base; +- ++ + if (bsb>bst) + (*fn)(bsb,bst,C_GC_OFFSET); + else + (*fn)(bst,bsb,C_GC_OFFSET); +- ++ + } + #endif +- ++ + } + + static void +@@ -1035,7 +999,7 @@ contblock_sweep_phase(void) { + struct pageinfo *v; + STATIC char *s, *e, *p, *q; + ufixnum i; +- ++ + reset_contblock_freelist(); + + for (i=0;iv.v_fillp && (v=(void *)contblock_array->v.v_self[i]);i++) { +@@ -1045,7 +1009,7 @@ contblock_sweep_phase(void) { + #ifdef SGC + if (sgc_enabled && !(v->sgc_flags&SGC_PAGE_FLAG)) continue; + #endif +- ++ + s=CB_DATA_START(v); + e=(void *)v+v->in_use*PAGESIZE; + +@@ -1070,25 +1034,6 @@ contblock_sweep_phase(void) { + int (*GBC_enter_hook)() = NULL; + int (*GBC_exit_hook)() = NULL; + +-/* void */ +-/* ttss(void) { */ +- +-/* struct typemanager *tm; */ +-/* void *x,*y; */ +- +-/* for (tm=tm_table;tmtm_free;x!=OBJNULL;x=(void *)((struct freelist *)x)->f_link) { */ +-/* if (x==Cnil) */ +-/* printf("barr\n"); */ +-/* /\* for (y=(void *)((struct freelist *)x)->f_link;y!=OBJNULL && y!=x;y=(void *)((struct freelist *)y)->f_link); *\/ */ +-/* /\* if (y==x) *\/ */ +-/* /\* printf("circle\n"); *\/ */ +-/* } */ +-/* } */ +- +-/* } */ +- + fixnum fault_pages=0; + + static ufixnum +@@ -1102,7 +1047,7 @@ count_contblocks(void) { + return ncb; + + } +- ++ + + void + GBC(enum type t) { +@@ -1120,7 +1065,7 @@ GBC(enum type t) { + + ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind); + recent_allocation=0; +- ++ + if (in_signal_handler && t == t_relocatable) + error("cant gc relocatable in signal handler"); + +@@ -1146,7 +1091,6 @@ GBC(enum type t) { + close_stream(o); + } + +- /* t = t_relocatable; */ + gc_time = -1; + } + +@@ -1265,54 +1209,6 @@ GBC(enum type t) { + #endif + } + +- +-/* { */ +-/* static int promoting; */ +-/* if (!promoting && promotion_pointer>promotion_pointer1) { */ +-/* object *p,st; */ +-/* promoting=1; */ +-/* st=alloc_simple_string(""); */ +-/* for (p=promotion_pointer1;pst.st_dim; */ +- +-/* else switch (x->v.v_elttype) { */ +- +-/* case aet_lf: */ +-/* j=sizeof(longfloat)*x->v.v_dim; */ +-/* break; */ +-/* case aet_bit: */ +-/* #define W_SIZE (8*sizeof(fixnum)) */ +-/* j=sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); */ +-/* break; */ +-/* case aet_char: */ +-/* case aet_uchar: */ +-/* j=sizeof(char)*x->v.v_dim; */ +-/* break; */ +-/* case aet_short: */ +-/* case aet_ushort: */ +-/* j=sizeof(short)*x->v.v_dim; */ +-/* break; */ +-/* default: */ +-/* j=sizeof(fixnum)*x->v.v_dim; */ +-/* } */ +- +-/* st->st.st_dim=j; */ +-/* st->st.st_self=alloc_contblock(st->st.st_dim); */ +-/* fprintf(stderr,"Promoting vector leaf bytes %lu at %p, %p -> %p\n",j,x,x->v.v_self,st->st.st_self); */ +-/* fflush(stderr); */ +-/* memcpy(st->st.st_self,x->v.v_self,st->st.st_dim); */ +-/* x->v.v_self=(void *)st->st.st_self; */ +-/* } */ +-/* promoting=0; */ +-/* } */ +-/* } */ +- +- + #ifdef DEBUG + if (debug) { + int i,j; +@@ -1361,8 +1257,6 @@ GBC(enum type t) { + + CHECK_INTERRUPT; + +- /* ttss(); */ +- + } + + static void +@@ -1472,7 +1366,7 @@ mark_contblock(void *p, int s) { + STATIC char *q; + STATIC char *x, *y; + struct pageinfo *v; +- ++ + if (NULL_OR_ON_C_STACK(p)) + return; + +@@ -1495,17 +1389,17 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + ufixnum i,j,k,s; + struct typemanager *tm=tm_of(t_cfdata); + void *p; +- ++ + for (i=j=0,cbpp=&cb_pointer;(*cbpp);) { + for (k=0,s=(*cbpp)->cb_size,p=*cbpp;*cbpp && (*cbpp)->cb_size==s;i+=(*cbpp)->cb_size,j++,k++,cbpp=&(*cbpp)->cb_link); + emsg("%lu %lu starting at %p\n",k,s,p); + } + emsg("\nTotal free %lu in %lu pieces\n\n",i,j); +- +- for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) ++ ++ for (i=j=k=0;kv.v_fillp && (v=(void *)contblock_array->v.v_self[k]);k++,i+=v->in_use,j++) + emsg("%lu pages at %p\n",(unsigned long)v->in_use,v); + emsg("\nTotal pages %lu in %lu pieces\n\n",i,j); +- ++ + for (i=j=0,v=cell_list_head;v;v=v->next) + if (tm->tm_type==v->type) { + void *p; +@@ -1520,7 +1414,7 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + } + } + emsg("\nTotal code bytes %lu in %lu pieces\n",i,j); +- ++ + for (i=j=0,v=cell_list_head;v;v=v->next) { + struct typemanager *tm=tm_of(v->type); + void *p; +@@ -1589,15 +1483,13 @@ DEFUN_NEW("CONTIGUOUS-REPORT",object,fSc + } + } + emsg("\nTotal leaf bytes %lu in %lu pieces\n",i,j); +- ++ + return Cnil; + + } + + DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE,OO,OO,OO,OO,(object x0),"") { + +- /* 1 args */ +- + if (x0 == Ct) { + tm_table[t_contiguous].tm_adjgbccnt--; + GBC(t_other); +@@ -1644,5 +1536,5 @@ gcl_init_GBC(void) { + #ifdef SGC + make_si_function("SGC-ON",siLsgc_on); + #endif +- ++ + } +--- gcl-2.6.12.orig/o/iteration.c ++++ gcl-2.6.12/o/iteration.c +@@ -95,7 +95,7 @@ do_var_list(object var_list) + + + +- if (type_of(x) != t_cons) ++ if (!consp(x)) + FEinvalid_form("The index, ~S, is illegal.", x); + y = MMcar(x); + check_var(y); +@@ -326,7 +326,7 @@ FFN(Fdolist)(VOL object arg) + } + + eval_assign(start->bt_init, listform); +- body = find_special(MMcdr(arg), start, start+1); ++ body = find_special(MMcdr(arg), start, start+1,NULL); /*?*/ + vs_push(body); + bind_var(start->bt_var, Cnil, start->bt_spp); + if ((enum stype)start->bt_var->s.s_stype != stp_ordinary) +@@ -410,7 +410,7 @@ FFN(Fdotimes)(VOL object arg) + if (type_of(start->bt_init) != t_fixnum && + type_of(start->bt_init) != t_bignum) + FEwrong_type_argument(sLinteger, start->bt_init); +- body = find_special(MMcdr(arg), start, start+1); ++ body = find_special(MMcdr(arg), start, start+1,NULL); /*?*/ + vs_push(body); + bind_var(start->bt_var, make_fixnum(0), start->bt_spp); + if ((enum stype)start->bt_var->s.s_stype != stp_ordinary) { +--- gcl-2.6.12.orig/o/let.c ++++ gcl-2.6.12/o/let.c +@@ -151,7 +151,7 @@ FFN(Fmultiple_value_bind)(object form) + } + { + object *vt = vs_top; +- vs_push(find_special(body, start, (struct bind_temp *)vt)); ++ vs_push(find_special(body, start, (struct bind_temp *)vt,NULL)); /*?*/ + } + for (i = 0; i < n; i++) + bind_var(start[i].bt_var, +@@ -230,7 +230,7 @@ is an illegal function definition in FLE + lex_fun_bind(MMcar(def), top[0]); + def_list = MMcdr(def_list); + } +- vs_push(find_special(MMcdr(args), NULL, NULL)); ++ vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); + Fprogn(vs_head); + lex_env = lex; + } +@@ -271,7 +271,7 @@ is an illegal function definition in LAB + MMcaar(closure_list) = lex_env[1]; + closure_list = MMcdr(closure_list); + } +- vs_push(find_special(MMcdr(args), NULL, NULL)); ++ vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); + Fprogn(vs_head); + lex_env = lex; + } +@@ -304,7 +304,7 @@ is an illegal macro definition in MACROF + lex_macro_bind(MMcar(def), MMcaddr(top[0])); + def_list = MMcdr(def_list); + } +- vs_push(find_special(MMcdr(args), NULL, NULL)); ++ vs_push(find_special(MMcdr(args), NULL, NULL,NULL)); + Fprogn(vs_head); + lex_env = lex; + } +--- gcl-2.6.12.orig/o/pathname.d ++++ gcl-2.6.12/o/pathname.d +@@ -28,744 +28,93 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include + #include "include.h" + ++DEFUN_NEW("C-SET-T-TT",object,fSc_set_t_tt,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum y),"") { ++ x->d.tt=y; ++ RETURN1(x); ++} ++ ++ ++DEFUN_NEW("C-T-TT",object,fSc_t_tt,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { ++ RETURN1((object)(fixnum)x->d.tt); ++} ++ ++ ++DEFUN_NEW("C-SET-PATHNAME-NAMESTRING",object,fSc_set_pathname_namestring,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ check_type_pathname(&x); ++ x->pn.pn_namestring=y; ++ RETURN1(x); ++} ++ ++DEFUN_NEW("C-PATHNAME-HOST",object,fSc_pathname_host,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_host); ++} ++DEFUN_NEW("C-PATHNAME-DEVICE",object,fSc_pathname_device,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_device); ++} ++DEFUN_NEW("C-PATHNAME-DIRECTORY",object,fSc_pathname_directory,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_directory); ++} ++DEFUN_NEW("C-PATHNAME-NAME",object,fSc_pathname_name,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_name); ++} ++DEFUN_NEW("C-PATHNAME-TYPE",object,fSc_pathname_type,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_type); ++} ++DEFUN_NEW("C-PATHNAME-VERSION",object,fSc_pathname_version,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_version); ++} ++DEFUN_NEW("C-PATHNAME-NAMESTRING",object,fSc_pathname_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_pathname(&x); ++ RETURN1(x->pn.pn_namestring); ++} + +-object +-make_pathname(host, device, directory, name, type, version) +-object host, device, directory, name, type, version; +-{ +- object x; +- +- x = alloc_object(t_pathname); +- x->pn.pn_host = host; +- x->pn.pn_device = device; +- x->pn.pn_directory = directory; +- x->pn.pn_name = name; +- x->pn.pn_type = type; +- x->pn.pn_version = version; +- return(x); +-} +- +-static void +-make_one(s, end) +-char *s; +-int end; +-{ +- int i; +- +-#ifdef UNIX +- for (i = 0; i < end; i++) +- token->st.st_self[i] = s[i]; +-#endif +-#ifdef AOSVS +- +- +- +-#endif +- token->st.st_fillp = end; +- vs_push(copy_simple_string(token)); +-} +- +-/* The function below does not attempt to handle DOS pathnames +- which use backslashes as directory separators. It needs +- TLC from someone who feels pedantic. MJT */ +- +-/* !!!!! Bug Fix. NLG */ +-object +-parse_namestring(s, start, end, ep) +-object s; +-int start, end, *ep; +-{ +- int i, j, k, founddosdev = FALSE, oldstart=start, oldend=end, justdevice = FALSE; +- int d; +- object *vsp; +- object x; +- vs_mark; +- +-#ifndef IS_DIR_SEPARATOR +-#define IS_DIR_SEPARATOR(x) (x == '/') +-#endif +- +- *ep=oldend; +- vsp = vs_top + 1; +- for (;--end >= start && isspace((int)s->st.st_self[end]);); +- +- /* Check for a DOS path and process later */ +- if ( ( (start+1) <= end) && (s->st.st_self[start+1] == ':' )) { +- start+=2; +- founddosdev = TRUE; +- } +- if ( start > end ) { +- make_one(&s->st.st_self[0], 0); +- justdevice = TRUE; +- } else { +- for (i = j = start; i <= end; ) { +-#ifdef UNIX +- if (IS_DIR_SEPARATOR(s->st.st_self[i])) { +-#endif +- if (j == start && i == start) { +- i++; +- vs_push(sKroot); +- j = i; +- continue; +- } +-#ifdef UNIX +- if (i-j == 1 && s->st.st_self[j] == '.') { +- vs_push(sKcurrent); +- } else if (i-j == 1 && s->st.st_self[j] == '*') { +- vs_push(sKwild); +- } else if (i-j==2 && s->st.st_self[j]=='.' && s->st.st_self[j+1]=='.') { +- vs_push(sKparent); +- } else { +- make_one(&s->st.st_self[j], i-j); +- } +-#endif +- i++; +- j = i; +- } else { +- i++; +- } +- } +- *ep = i; +- vs_push(Cnil); +- while (vs_top > vsp) +- stack_cons(); +- if (i == j) { +- /* no file and no type */ +- vs_push(Cnil); +- vs_push(Cnil); +- goto L; +- } +- for (k = j, d = -1; k < i; k++) +- if (s->st.st_self[k] == '.') +- d = k; +- if (d == -1) { +- /* no file type */ +-#ifdef UNIX +- if (i-j == 1 && s->st.st_self[j] == '*') +-#endif +- vs_push(sKwild); +- else +- make_one(&s->st.st_self[j], i-j); +- +- vs_push(Cnil); +- } else if (d == j) { +- /* no file name */ +- vs_push(Cnil); +-#ifdef UNIX +- if (i-d-1 == 1 && s->st.st_self[d+1] == '*') +-#endif +- vs_push(sKwild); +- else +- make_one(&s->st.st_self[d+1], i-d-1); +- } else { +- /* file name and file type */ +-#ifdef UNIX +- if (d-j == 1 && s->st.st_self[j] == '*') +-#endif +- vs_push(sKwild); +- else { +- make_one(&s->st.st_self[j], d-j); +- } +-#ifdef UNIX +- if (i-d-1 == 1 && s->st.st_self[d+1] == '*') +-#endif +- vs_push(sKwild); +- else +- make_one(&s->st.st_self[d+1], i-d-1); +- } +- } +-L: +- /* Process DOS device name found earlier, build a string in a list and push it */ +- if ( founddosdev ) { +- /* Drive letter */ +- token->st.st_self[0] = s->st.st_self[oldstart]; +- /* Colon */ +- token->st.st_self[1] = s->st.st_self[oldstart+1]; +- /* Fill pointer */ +- token->st.st_fillp = 2; +- /* Push */ +- vs_push(make_cons(copy_simple_string(token),Cnil)); +- } else { +- /* No device name */ +- vs_push(Cnil); +- } +- if ( justdevice ) { +- x = make_pathname ( Cnil, vs_top[-1], Cnil, Cnil, Cnil, Cnil ); +- } else { +- x = make_pathname ( Cnil, vs_top[-1], vs_top[-4], vs_top[-3], vs_top[-2], Cnil ); +- } +- vs_reset; +- return(x); +-} +- +-object +-coerce_to_pathname(x) +-object x; +-{ +- object y; +- int e; +- +-L: +- switch (type_of(x)) { +- case t_symbol: +- case t_string: +- /* !!!!! Bug Fix. NLG */ +- y = parse_namestring(x, 0, x->st.st_fillp, &e); +- if (y == OBJNULL || e != x->st.st_fillp) +- goto CANNOT_COERCE; +- return(y); +- +- case t_pathname: +- return(x); +- +- case t_stream: +- switch (x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_probe: +- case smm_io: +- x = x->sm.sm_object1; +- /* +- The file was stored in sm.sm_object1. +- See open. +- */ +- goto L; +- +- case smm_synonym: +- x = symbol_value(x->sm.sm_object0); +- goto L; +- +- default: +- goto CANNOT_COERCE; +- } +- +- default: +- CANNOT_COERCE: +- FEerror("~S cannot be coerced to a pathname.", 1, x); +- return(Cnil); +- } +-} +- +-static object +-default_device(host) +-object host; +-{ +- return(Cnil); +- /* not implemented yet */ +-} +- +-object +-merge_pathnames(path, defaults, default_version) +-object path, defaults, default_version; +-{ +- object host, device, directory, name, type, version; +- +- if (path->pn.pn_host == Cnil) +- host = defaults->pn.pn_host; +- else +- host = path->pn.pn_host; +- if (path->pn.pn_device == Cnil) +- if (path->pn.pn_host == Cnil) +- device = defaults->pn.pn_device; +- else if (path->pn.pn_host == defaults->pn.pn_host) +- device = defaults->pn.pn_device; +- else +- device = default_device(path->pn.pn_host); +- else +- device = path->pn.pn_device; +- +- if (defaults->pn.pn_directory==Cnil || +- (type_of(path->pn.pn_directory)==t_cons +- && path->pn.pn_directory->c.c_car==sKroot)) +- directory=path->pn.pn_directory; +- else +- directory=path->pn.pn_directory==Cnil ? +- defaults->pn.pn_directory : +- append(defaults->pn.pn_directory,path->pn.pn_directory); +- +- if (path->pn.pn_name == Cnil) +- name = defaults->pn.pn_name; +- else +- name = path->pn.pn_name; +- if (path->pn.pn_type == Cnil) +- type = defaults->pn.pn_type; +- else +- type = path->pn.pn_type; +- version = Cnil; +- /* +- In this implimentation, version is not counted +- */ +- return(make_pathname(host,device,directory,name,type,version)); +-} +- +-/* +- Namestring(x) converts a pathname to a namestring. +-*/ +-object +-namestring(x) +-object x; +-{ +- +- int i, j; +- object l, y; +- +- i = 0; +- +- l = x->pn.pn_device; +- if (endp(l)) { +- goto D; +- } +- y = l->c.c_car; +- y = coerce_to_string(y); +- for (j = 0; j < y->st.st_fillp; j++) { +- token->st.st_self[i++] = y->st.st_self[j]; +- } +- +-D: l = x->pn.pn_directory; +- if (endp(l)) +- goto L; +- y = l->c.c_car; +- if (y == sKroot) { +-#ifdef UNIX +- token->st.st_self[i++] = '/'; +-#endif +- l = l->c.c_cdr; +- } +- for (; !endp(l); l = l->c.c_cdr) { +- y = l->c.c_car; +-#ifdef UNIX +- if (y == sKcurrent) { +- token->st.st_self[i++] = '.'; +- token->st.st_self[i++] = '/'; +- continue; +- } else if (y == sKwild) { +- token->st.st_self[i++] = '*'; +- token->st.st_self[i++] = '/'; +- continue; +- } else if (y == sKparent) { +- token->st.st_self[i++] = '.'; +- token->st.st_self[i++] = '.'; +- token->st.st_self[i++] = '/'; +- continue; +- } +-#endif +- y = coerce_to_string(y); +- for (j = 0; j < y->st.st_fillp; j++) +- token->st.st_self[i++] +- = y->st.st_self[j]; +-#ifdef UNIX +- token->st.st_self[i++] = '/'; +-#endif +-#ifdef AOSVS +- +-#endif +- } +-L: +- y = x->pn.pn_name; +- if (y == Cnil) +- goto M; +- if (y == sKwild) { +-#ifdef UNIX +- token->st.st_self[i++] = '*'; +-#endif +-#ifdef AOSVS +- +-#endif +- goto M; +- } +- if (type_of(y) != t_string) +- FEerror("~S is an illegal pathname name.", 1, y); +- for (j = 0; j < y->st.st_fillp; j++) +- token->st.st_self[i++] = y->st.st_self[j]; +-M: +- y = x->pn.pn_type; +- if (y == Cnil) +- goto N; +- if (y == sKwild) { +- token->st.st_self[i++] = '.'; +-#ifdef UNIX +- token->st.st_self[i++] = '*'; +-#endif +-#ifdef AOSVS +- +-#endif +- goto N; +- } +- if (type_of(y) != t_string) +- FEerror("~S is an illegal pathname name.", 1, y); +- token->st.st_self[i++] = '.'; +- for (j = 0; j < y->st.st_fillp; j++) +- token->st.st_self[i++] = y->st.st_self[j]; +-N: +- token->st.st_fillp = i; +-#ifdef FIX_FILENAME +- {char buf[MAXPATHLEN]; +- if (i > MAXPATHLEN-1) i =MAXPATHLEN-1; +- memcpy(buf,token->st.st_self,i); +- buf[i]=0; +- FIX_FILENAME(x,buf); +- return (make_simple_string(buf)); +- } +-#endif +- return(copy_simple_string(token)); +-} +- +-object +-coerce_to_namestring(x) +-object x; +-{ +- +-L: +- switch (type_of(x)) { +- case t_symbol: +- {BEGIN_NO_INTERRUPT; +- vs_push(alloc_simple_string(x->s.s_fillp)); +- /* By Nick Gall */ +- vs_head->st.st_self = alloc_relblock(x->s.s_fillp); +- { +- int i; +- for (i = 0; i < x->s.s_fillp; i++) +- vs_head->st.st_self[i] = x->s.s_self[i]; +- } +- END_NO_INTERRUPT;} +- return(vs_pop); +- +- case t_string: +- return(x); +- +- case t_pathname: +- return(namestring(x)); +- +- case t_stream: +- switch (x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_probe: +- case smm_io: +- x = x->sm.sm_object1; +- /* +- The file was stored in sm.sm_object1. +- See open. +- */ +- goto L; +- +- case smm_synonym: +- x = symbol_value(x->sm.sm_object0); +- goto L; +- +- default: +- goto CANNOT_COERCE; +- } +- +- default: +- CANNOT_COERCE: +- FEerror("~S cannot be coerced to a namestring.", 1, x); +- return(Cnil); +- } +-} +- +-LFD(Lpathname)(void) +-{ +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +-} +- +-@(defun parse_namestring (thing +- &o host +- (defaults `symbol_value(Vdefault_pathname_defaults)`) +- &k start end junk_allowed +- &a x y) +- int s, e, ee; +-@ +- check_type_or_pathname_string_symbol_stream(&thing); +- check_type_or_pathname_string_symbol_stream(&defaults); +- defaults = coerce_to_pathname(defaults); +- x = thing; +-L: +- switch (type_of(x)) { +- case t_symbol: +- case t_string: +- get_string_start_end(x, start, end, &s, &e); +- for (; s < e && isspace((int)x->st.st_self[s]); s++) +- ; +- y +- /* !!!!! Bug Fix. NLG */ +- = parse_namestring(x, +- s, +- e - s, +- &ee); +- if (junk_allowed == Cnil) { +- for (; ee < e - s; ee++) +- if (!isspace((int)x->st.st_self[s + ee])) +- break; +- if (y == OBJNULL || ee != e - s) +- FEerror("Cannot parse the namestring ~S~%\ +-from ~S to ~S.", +- 3, x, start, end); +- } else +- if (y == OBJNULL) +- @(return Cnil `make_fixnum(s + ee)`) +- start = make_fixnum(s + ee); +- break; +- +- case t_pathname: +- y = x; +- break; +- +- case t_stream: +- switch (x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_probe: +- case smm_io: +- x = x->sm.sm_object1; +- /* +- The file was stored in sm.sm_object1. +- See open. +- */ +- goto L; +- +- case smm_synonym: +- x = symbol_value(x->sm.sm_object0); +- goto L; +- +- default: +- goto CANNOT_PARSE; +- } +- +- default: +- CANNOT_PARSE: +- FEerror("Cannot parse the namestring ~S.", 1, x); +- } +- if (host != Cnil && y->pn.pn_host != Cnil && +- host != y->pn.pn_host) +- FEerror("The hosts ~S and ~S do not match.", +- 2, host, y->pn.pn_host); +- @(return y start) +-@) +- +-@(defun merge_pathnames (path +- &o (defaults `symbol_value(Vdefault_pathname_defaults)`) +- (default_version sKnewest)) +-@ +- check_type_or_pathname_string_symbol_stream(&path); +- check_type_or_pathname_string_symbol_stream(&defaults); +- path = coerce_to_pathname(path); +- defaults = coerce_to_pathname(defaults); +- @(return `merge_pathnames(path, defaults, default_version)`) +-@) +- +-@(defun make_pathname (&key +- (host `Cnil` host_supplied_p) +- (device `Cnil` device_supplied_p) +- (directory `Cnil` directory_supplied_p) +- (name `Cnil` name_supplied_p) +- (type `Cnil` type_supplied_p) +- (version `Cnil` version_supplied_p) +- defaults +- &aux x) +-@ +- if ( defaults == Cnil ) { +- defaults = symbol_value ( Vdefault_pathname_defaults ); +- defaults = coerce_to_pathname ( defaults ); +- defaults = make_pathname ( defaults->pn.pn_host, +- Cnil, Cnil, Cnil, Cnil, Cnil); +- } else { +- defaults = coerce_to_pathname(defaults); +- } +- x = make_pathname(host, device, directory, name, type, version); +- x = merge_pathnames(x, defaults, Cnil); +- if ( host_supplied_p) x->pn.pn_host = host; +- if (device_supplied_p) x->pn.pn_device = device; +- if (directory_supplied_p) x->pn.pn_directory = directory; +- if (name_supplied_p) x->pn.pn_name = name; +- if (type_supplied_p) x->pn.pn_type = type; +- if (version_supplied_p) x->pn.pn_version = version; +- @(return x) +-@) +- +-LFD(Lpathnamep)(void) +-{ +- check_arg(1); +- +- if (type_of(vs_base[0]) == t_pathname) +- vs_base[0] = Ct; +- else +- vs_base[0] = Cnil; +-} +- +-LFD(Lpathname_host)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_host; +-} +- +-LFD(Lpathname_device)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_device; +-} +- +-LFD(Lpathname_directory)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_directory; +-} +- +-LFD(Lpathname_name)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_name; +-} +- +-LFD(Lpathname_type)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_type; +-} +- +-LFD(Lpathname_version)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_version; +-} +- +-LFD(Lnamestring)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_namestring(vs_base[0]); +-} +- +-LFD(Lfile_namestring)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] +- = make_pathname(Cnil, Cnil, Cnil, +- vs_base[0]->pn.pn_name, +- vs_base[0]->pn.pn_type, +- vs_base[0]->pn.pn_version); +- vs_base[0] = namestring(vs_base[0]); +-} +- +-LFD(Ldirectory_namestring)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] +- = make_pathname(Cnil, Cnil, +- vs_base[0]->pn.pn_directory, +- Cnil, Cnil, Cnil); +- vs_base[0] = namestring(vs_base[0]); +-} +- +-LFD(Lhost_namestring)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0] = vs_base[0]->pn.pn_host; +- if (vs_base[0] == Cnil || vs_base[0] == sKwild) +- vs_base[0] = make_simple_string(""); +-} +- +-@(defun enough_namestring (path +- &o (defaults `symbol_value(Vdefault_pathname_defaults)`)) +-@ +- check_type_or_pathname_string_symbol_stream(&path); +- check_type_or_pathname_string_symbol_stream(&defaults); +- defaults = coerce_to_pathname(defaults); +- path = coerce_to_pathname(path); +- path +- = make_pathname(equalp(path->pn.pn_host, defaults->pn.pn_host) ? +- Cnil : path->pn.pn_host, +- equalp(path->pn.pn_device, +- defaults->pn.pn_device) ? +- Cnil : path->pn.pn_device, +- equalp(path->pn.pn_directory, +- defaults->pn.pn_directory) ? +- Cnil : path->pn.pn_directory, +- equalp(path->pn.pn_name, defaults->pn.pn_name) ? +- Cnil : path->pn.pn_name, +- equalp(path->pn.pn_type, defaults->pn.pn_type) ? +- Cnil : path->pn.pn_type, +- equalp(path->pn.pn_version, +- defaults->pn.pn_version) ? +- Cnil : path->pn.pn_version); +- @(return `namestring(path)`) +-@) ++ ++DEFUN_NEW("C-STREAM-OBJECT0",object,fSc_stream_object0,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(x->sm.sm_object0); ++} ++ ++DEFUN_NEW("C-STREAM-OBJECT1",object,fSc_stream_object1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(x->sm.sm_object1); ++} ++ ++DEFUN_NEW("C-SET-STREAM-OBJECT1",object,fSc_set_stream_object1,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ x->sm.sm_object1=y; ++ RETURN1(x); ++} ++ ++DEFUN_NEW("INIT-PATHNAME",object,fSinit_pathname,SI,7,7,NONE,OO,OO,OO,OO, ++ (object host,object device,object directory,object name,object type,object version,object namestring),"") { ++ ++ object x=alloc_object(t_pathname); ++ ++ x->pn.pn_host=host; ++ x->pn.pn_device=device; ++ x->pn.pn_directory=directory; ++ x->pn.pn_name=name; ++ x->pn.pn_type=type; ++ x->pn.pn_version=version; ++ x->pn.pn_namestring=namestring; ++ ++ RETURN1(x); ++ ++} ++ ++DEFUN_NEW("PATHNAMEP",object,fLpathnamep,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(type_of(x)==t_pathname ? Ct : Cnil); ++} + + void +-gcl_init_pathname(void) +-{ +- Vdefault_pathname_defaults = +- make_special("*DEFAULT-PATHNAME-DEFAULTS*", +- make_pathname(Cnil, Cnil, Cnil, Cnil, Cnil, Cnil)); +- +- sKwild = make_keyword("WILD"); +- sKnewest = make_keyword("NEWEST"); +- +- sKstart = make_keyword("START"); +- sKend = make_keyword("END"); +- sKjunk_allowed = make_keyword("JUNK-ALLOWED"); +- +- sKhost = make_keyword("HOST"); +- sKdevice = make_keyword("DEVICE"); +- sKdirectory = make_keyword("DIRECTORY"); +- sKname = make_keyword("NAME"); +- sKtype = make_keyword("TYPE"); +- sKversion = make_keyword("VERSION"); +- sKdefaults = make_keyword("DEFAULTS"); +- +- sKroot = make_keyword("ROOT"); +- sKcurrent = make_keyword("CURRENT"); +- sKparent = make_keyword("PARENT"); +- sKper = make_keyword("PER"); ++gcl_init_pathname(void) { ++ + } + + void +-gcl_init_pathname_function() +-{ +- make_function("PATHNAME", Lpathname); +- make_function("PARSE-NAMESTRING", Lparse_namestring); +- make_function("MERGE-PATHNAMES", Lmerge_pathnames); +- make_function("MAKE-PATHNAME", Lmake_pathname); +- make_function("PATHNAMEP", Lpathnamep); +- make_function("PATHNAME-HOST", Lpathname_host); +- make_function("PATHNAME-DEVICE", Lpathname_device); +- make_function("PATHNAME-DIRECTORY", Lpathname_directory); +- make_function("PATHNAME-NAME", Lpathname_name); +- make_function("PATHNAME-TYPE", Lpathname_type); +- make_function("PATHNAME-VERSION", Lpathname_version); +- make_function("NAMESTRING", Lnamestring); +- make_function("FILE-NAMESTRING", Lfile_namestring); +- make_function("DIRECTORY-NAMESTRING", Ldirectory_namestring); +- make_function("HOST-NAMESTRING", Lhost_namestring); +- make_function("ENOUGH-NAMESTRING", Lenough_namestring); ++gcl_init_pathname_function(void) { ++ + } +--- gcl-2.6.12.orig/o/predicate.c ++++ gcl-2.6.12/o/predicate.c +@@ -29,6 +29,10 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include + #include "include.h" + ++DEFUN_NEW("PATHNAME-DESIGNATORP",object,fSpathname_designatorp,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ RETURN1(pathname_designatorp(x) ? Ct : Cnil); ++} ++ + DEFUNO_NEW("NULL",object,fLnull,LISP + ,1,1,NONE,OO,OO,OO,OO,void,Lnull,(object x0),"") + { +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -1260,6 +1260,7 @@ int level; + write_ch('>'); + break; + ++ case smm_file_synonym: + case smm_synonym: + write_str("#sm.sm_object0, level); +@@ -1381,7 +1382,7 @@ int level; + if (1 || PRINTescape) { + write_ch('#'); + write_ch('p'); +- vs_push(namestring(x)); ++ vs_push(x->pn.pn_namestring==Cnil ? make_simple_string("") : x->pn.pn_namestring); + write_object(vs_head, level); + vs_popp; + } else { +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -1564,38 +1564,6 @@ Ldefault_dispatch_macro() + } + + /* +- #p" ... " returns the pathname with namestring ... . +-*/ +-static void +-Lsharp_p_reader() +-{ +- check_arg(3); +- if (vs_base[2] != Cnil && !READsuppress) +- extra_argument('p'); +- vs_popp; +- vs_popp; +- vs_base[0] = read_object(vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +-} +- +-/* +- #" ... " returns the pathname with namestring ... . +-*/ +-static void +-Lsharp_double_quote_reader() +-{ +- check_arg(3); +- +- if (vs_base[2] != Cnil && !READsuppress) +- extra_argument('"'); +- vs_popp; +- unread_char(vs_base[1], vs_base[0]); +- vs_popp; +- vs_base[0] = read_object(vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +-} +- +-/* + #$ fixnum returns a random-state with the fixnum + as its content. + */ +@@ -2369,9 +2337,6 @@ gcl_init_read() + dtab['<'] = make_cf(Lsharp_less_than_reader); + */ + dtab['|'] = make_cf(Lsharp_vertical_bar_reader); +- dtab['"'] = make_cf(Lsharp_double_quote_reader); +- dtab['p'] = make_cf(Lsharp_p_reader); +- dtab['P'] = make_cf(Lsharp_p_reader); + /* This is specific to this implimentation */ + dtab['$'] = make_cf(Lsharp_dollar_reader); + /* This is specific to this implimentation */ +--- gcl-2.6.12.orig/o/regexp.c ++++ gcl-2.6.12/o/regexp.c +@@ -117,7 +117,7 @@ min_initial_branch_length(regexp *, unsi + #define PLUS 11 /* node Match this (simple) thing 1 or more times. */ + #define OPEN 20 /* no Mark this point in input as start of #n. */ + /* OPEN+1 is number 1, etc. */ +-#define CLOSE 30 /* no Analogous to OPEN. */ ++#define CLOSE (OPEN+NSUBEXP) /* no Analogous to OPEN. */ + + /* + * Opcode notes: +@@ -1083,15 +1083,8 @@ regmatch(char *prog) + break; + case BACK: + break; +- case OPEN+1: +- case OPEN+2: +- case OPEN+3: +- case OPEN+4: +- case OPEN+5: +- case OPEN+6: +- case OPEN+7: +- case OPEN+8: +- case OPEN+9: { ++ case OPEN+1 ... OPEN+NSUBEXP-1: ++ { + register int no; + register char *save; + +@@ -1112,15 +1105,8 @@ regmatch(char *prog) + } + /* NOTREACHED */ + break; +- case CLOSE+1: +- case CLOSE+2: +- case CLOSE+3: +- case CLOSE+4: +- case CLOSE+5: +- case CLOSE+6: +- case CLOSE+7: +- case CLOSE+8: +- case CLOSE+9: { ++ case CLOSE+1 ... CLOSE+NSUBEXP-1: ++ { + register int no; + register char *save; + +@@ -1394,27 +1380,11 @@ char *op; + case END: + p = "END"; + break; +- case OPEN+1: +- case OPEN+2: +- case OPEN+3: +- case OPEN+4: +- case OPEN+5: +- case OPEN+6: +- case OPEN+7: +- case OPEN+8: +- case OPEN+9: ++ case OPEN+1 ... OPEN+NSUBEXP-1: + sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN); + p = NULL; + break; +- case CLOSE+1: +- case CLOSE+2: +- case CLOSE+3: +- case CLOSE+4: +- case CLOSE+5: +- case CLOSE+6: +- case CLOSE+7: +- case CLOSE+8: +- case CLOSE+9: ++ case CLOSE+1 ... CLOSE+NSUBEXP-1: + sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE); + p = NULL; + break; +--- gcl-2.6.12.orig/o/regexp.h ++++ gcl-2.6.12/o/regexp.h +@@ -1,7 +1,7 @@ + #ifndef _REGEXP + #define _REGEXP 1 + +-#define NSUBEXP 10 ++#define NSUBEXP 19 + typedef struct regexp { + char *startp[NSUBEXP]; + char *endp[NSUBEXP]; +--- gcl-2.6.12.orig/o/regexpr.c ++++ gcl-2.6.12/o/regexpr.c +@@ -81,6 +81,7 @@ DEFUN_NEW("COMPILE-REGEXP",object,fScomp + res->v.v_elttype=aet_uchar; + res->v.v_adjustable=0; + res->v.v_offset=0; ++ res->v.v_self=NULL; + if (!(res->v.v_self=(void *)regcomp(tmp,&res->v.v_dim))) + FEerror("regcomp failure",0); + res->v.v_fillp=res->v.v_dim; +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -177,10 +177,12 @@ void run_process ( char *name ) + stream_in->sm.sm_mode = smm_input; + stream_in->sm.sm_fp = ofp; + stream_in->sm.sm_buffer = 0; ++ stream_in->sm.sm_flags=0; + stream_out = (object) alloc_object(t_stream); + stream_out->sm.sm_mode = smm_output; + stream_out->sm.sm_fp = ifp; + stream_out->sm.sm_buffer = 0; ++ stream_out->sm.sm_flags=0; + setup_stream_buffer ( stream_in ); + setup_stream_buffer ( stream_out ); + stream = make_two_way_stream ( stream_in, stream_out ); +@@ -433,6 +435,7 @@ enum smmode smm; + stream->sm.sm_object0 = sLcharacter; + stream->sm.sm_object1 = host_l; + stream->sm.sm_int0 = stream->sm.sm_int1 = 0; ++ stream->sm.sm_flags=0; + vs_push(stream); + setup_stream_buffer(stream); + vs_reset; +@@ -503,6 +506,7 @@ make_socket_pair() + stream_in->sm.sm_int0 = sockets_in[1]; + stream_in->sm.sm_int1 = 0; + stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL; ++ stream_in->sm.sm_flags = 0; + stream_out = (object) alloc_object(t_stream); + stream_out->sm.sm_mode = smm_output; + stream_out->sm.sm_fp = fp2; +@@ -511,6 +515,7 @@ make_socket_pair() + setup_stream_buffer(stream_out); + stream_out->sm.sm_int0 = sockets_out[1]; + stream_out->sm.sm_int1 = 0; ++ stream_out->sm.sm_flags = 0; + stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL; + stream = make_two_way_stream(stream_in, stream_out); + return(stream); +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -151,6 +151,16 @@ find_init_address(struct syment *sym,str + + } + ++static ul ++get_sym_value(const char *name) { ++ ++ struct node *answ; ++ ++ return (answ=find_sym_ptable(name)) ? answ->address : ++ ({massert(!emsg("Unrelocated non-local symbol: %s\n",name));0;}); ++ ++} ++ + static void + relocate_symbols(struct syment *sym,struct syment *sye,struct scnhdr *sec1,char *st1) { + +@@ -163,22 +173,10 @@ relocate_symbols(struct syment *sym,stru + + else if (!sym->n_scnum) { + +- char c=0,*s; +- +- if (sym->n.n.n_zeroes) { +- c=sym->n.n_name[8]; +- sym->n.n_name[8]=0; +- s=sym->n.n_name; +- } else +- s=st1+sym->n.n.n_offset; +- +- if ((answ=find_sym_ptable(s))) +- sym->n_value=answ->address; ++ if (sym->n.n.n_zeroes) ++ STOP(sym->n.n_name,sym->n_value=get_sym_value(sym->n.n_name)); + else +- massert(!emsg("Unrelocated non-local symbol: %s\n",s)); +- +- if (c) +- sym->n.n_name[8]=c; ++ sym->n_value=get_sym_value(st1+sym->n.n.n_offset); + + } + +@@ -391,13 +389,11 @@ fasload(object faslfile) { + struct reloc *rel,*rele; + object memory, data; + FILE *fp; +- char filename[MAXPATHLEN],*st1,*ste; ++ char *st1,*ste; + int i; + ul init_address=0; + void *st,*est; + +- coerce_to_filename(faslfile, filename); +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + fp = faslfile->sm.sm_fp; + + massert(st=get_mmap(fp,&est)); +@@ -427,7 +423,6 @@ fasload(object faslfile) { + data = read_fasl_vector(faslfile); + + massert(!un_mmap(st,est)); +- close_stream(faslfile); + + #ifdef CLEAR_CACHE + CLEAR_CACHE; +--- gcl-2.6.12.orig/o/sfaslelf.c ++++ gcl-2.6.12/o/sfaslelf.c +@@ -542,15 +542,13 @@ int + fasload(object faslfile) { + + FILE *fp; +- char filename[256],*sn,*st1,*dst1; ++ char *sn,*st1,*dst1; + ul init_address=0,end,gs=0,*got=&gs,*gote=got+1; + object memory,data; + Shdr *sec1,*sece; + Sym *sym1,*syme,*dsym1,*dsyme; + void *v1,*ve; + +- coerce_to_filename(faslfile, filename); +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + fp = faslfile->sm.sm_fp; + + massert(v1=get_mmap(fp,&ve)); +@@ -573,7 +571,6 @@ fasload(object faslfile) { + data=feof(fp) ? 0 : read_fasl_vector(faslfile); + + massert(!un_mmap(v1,ve)); +- close_stream(faslfile); + + massert(!clear_protect_memory(memory)); + +--- gcl-2.6.12.orig/o/sfaslmacho.c ++++ gcl-2.6.12/o/sfaslmacho.c +@@ -524,7 +524,6 @@ fasload(object faslfile) { + + FILE *fp; + object data; +- char filename[256]; + ul init_address=-1; + object memory; + void *v1,*ve,*p; +@@ -533,8 +532,6 @@ fasload(object faslfile) { + char *st1=NULL,*ste=NULL; + ul gs,*got=&gs,*gote,*io1=NULL,rls,start; + +- coerce_to_filename(faslfile, filename); +- faslfile = open_stream(faslfile, smm_input, Cnil, sKerror); + fp = faslfile->sm.sm_fp; + + massert(v1=get_mmap(fp,&ve)); +@@ -563,7 +560,6 @@ fasload(object faslfile) { + #endif + + massert(!un_mmap(v1,ve)); +- close_stream(faslfile); + + init_address-=(ul)memory->cfd.cfd_start; + call_init(init_address,memory,data,0); +--- gcl-2.6.12.orig/o/sgbc.c ++++ gcl-2.6.12/o/sgbc.c +@@ -717,7 +717,7 @@ sgc_start(void) { + void *p=NULL,*pe; + struct pageinfo *pi; + ufixnum i; +- ++ + old_cb_pointer=cb_pointer; + reset_contblock_freelist(); + +@@ -774,6 +774,8 @@ sgc_start(void) { + object v=sSAwritableA->s.s_dbind; + for (i=page(v->v.v_self);i<=page(v->v.v_self+CEI(v->bv.bv_offset+v->v.v_dim-1,8*sizeof(fixnum))/(8*sizeof(fixnum)));i++) + SET_WRITABLE(i); ++ SET_WRITABLE(page(v)); ++ SET_WRITABLE(page(sSAwritableA)); + } + + tm_of(t_relocatable)->tm_alt_npage=0; +@@ -787,7 +789,7 @@ sgc_start(void) { + Turn memory protection on for the pages which are writable. + */ + sgc_enabled=1; +- if (memory_protect(1)) ++ if (memory_protect(1)) + sgc_quit(); + if (sSAnotify_gbcA->s.s_dbind != Cnil) + emsg("[SGC on]"); +@@ -897,7 +899,7 @@ sgc_quit(void) { + for (p=pagetochar(page(v)),j=tm->tm_nppage;j>0;--j,p+=tm->tm_size) + ((object) p)->d.s=SGC_NORMAL; + #endif +- ++ + for (i=0;iv.v_fillp &&(v=(void *)contblock_array->v.v_self[i]);i++) + if (v->sgc_flags&SGC_PAGE_FLAG) + bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v)); +@@ -931,7 +933,7 @@ memprotect_handler(int sig, long code, v + #endif + if (faddr >= (void *)core_end || faddr < data_start) { + static void *old_faddr; +- if (old_faddr==faddr) ++ if (old_faddr==faddr) + if (fault_count++ > 300) error("fault count too high"); + old_faddr=faddr; + INSTALL_MPROTECT_HANDLER; +@@ -1017,7 +1019,7 @@ memory_protect(int on) { + + if (writable==WRITABLE_PAGE_P(i) && ism.sm_fp); + + #endif + +-static void +-FFN(siLfaslink)(void) +-{ +- bds_ptr old_bds_top; +- int i; +- object package; +- +- check_arg(2); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- check_type_string(&vs_base[1]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[0]->pn.pn_type = FASL_string; +- vs_base[0] = namestring(vs_base[0]); +- package = symbol_value(sLApackageA); +- old_bds_top = bds_top; +- bds_bind(sLApackageA, package); +- i = faslink(vs_base[0], vs_base[1]); +- bds_unwind(old_bds_top); +- vs_top = vs_base; +- vs_push(make_fixnum(i)); +-} +- + #endif + #endif/* svr4 */ + #endif /* UNIXFASL */ + + void +-gcl_init_unixfasl(void) +-{ +-#ifdef FASLINK +- make_si_function("FASLINK", siLfaslink); +-#endif ++gcl_init_unixfasl(void) { + } +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -44,10 +44,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + #define HAVE_RENAME + #endif + +-void Ldirectory(void); +- +- +- + #ifdef NEED_GETWD + #include + +@@ -168,17 +164,41 @@ getwd(char *buffer) { + b_[_c+_d]=0;\ + }) + ++static object ++get_string(object x) { ++ switch(type_of(x)) { ++ case t_symbol: ++ case t_string: ++ return x; ++ case t_pathname: ++ return x->pn.pn_namestring; ++ case t_stream: ++ switch(x->sm.sm_mode) { ++ case smm_input: ++ case smm_output: ++ case smm_probe: ++ case smm_io: ++ return get_string(x->sm.sm_object1); ++ case smm_file_synonym: ++ case smm_synonym: ++ return get_string(x->sm.sm_object0->s.s_dbind); ++ } ++ } ++ return Cnil; ++} ++ ++ + void + coerce_to_filename(object pathname,char *p) { + +- object namestring=coerce_to_namestring(pathname); ++ object namestring=get_string(pathname); + unsigned e=namestring->st.st_fillp; +- char *q=namestring->st.st_self,*qe=q+e;; ++ char *q=namestring->st.st_self,*qe=q+e; + +- if (pathname==Cnil) ++ if (pathname==Cnil||namestring==Cnil) + FEerror ( "NIL argument.", 1, pathname ); + +- if (*q=='~') { ++ if (*q=='~' && e) { + + unsigned m=0; + char *s=++q,*c; +@@ -224,134 +244,6 @@ coerce_to_filename(object pathname,char + + } + +-object +-truename(object pathname) +-{ +- register char *p, *q; +- char filename[MAXPATHLEN]; +- char truefilename[MAXPATHLEN]; +- char current_directory[MAXPATHLEN]; +- char directory[MAXPATHLEN]; +-#ifdef __MINGW32__ +- DWORD current_directory_length = +- GetCurrentDirectory ( MAXPATHLEN, current_directory ); +- if ( MAXPATHLEN < current_directory_length ) { +- FEerror ( "truename got a current directory name larger than MAXPATHLEN", 1, "" ); +- } +- if ( 0 == current_directory_length ) { +- FEerror ( "truename could not determine the current directory.", 1, "" ); +- } +-#else +- massert(current_directory==getcwd(current_directory,sizeof(current_directory))); +-#endif +- +- coerce_to_filename(pathname, filename); +- +-#ifdef S_IFLNK +- { +- +- struct stat filestatus; +- int islinkcount=8; +- +- if (lstat(filename, &filestatus) >= 0) +- +- while (((filestatus.st_mode&S_IFMT) == S_IFLNK) && (--islinkcount>0)) { +- +- char newname[MAXPATHLEN]; +- int newlen; +- +- newlen=readlink(filename,newname,MAXPATHLEN-1); +- if (newlen < 0) +- return((FEerror("Symlink broken at ~S.",1,pathname),Cnil)); +- +- for (p = filename, q = 0; *p != '\0'; p++) +- if (*p == '/') q = p; +- if (q == 0 || *newname == '/') +- q = filename; +- else +- q++; +- +- memcpy(q,newname,newlen); +- q[newlen]=0; +- if (lstat(filename, &filestatus) < 0) +- islinkcount=0; /* It would be ANSI to do the following : +- return(file_error("Symlink broken at ~S.",pathname)); +- but this would break DIRECTORY if a file points to nowhere */ +- } +- } +-#endif +- +- for (p = filename, q = 0; *p != '\0'; p++) +- if (*p == '/') +- q = p; +- if (q == filename) { +- q++; +- p = "/"; +- } else if (q == 0) { +- q = filename; +- p = current_directory; +- } else +-#ifdef __MINGW32__ +- if ( ( q > filename ) && ( q[-1] == ':' ) ) { +- int current = (q++, q[0]); +- q[0]=0; +- if (chdir(filename) < 0) +- FEerror("Cannot get the truename of ~S.", 1, pathname); +- current_directory_length = +- GetCurrentDirectory ( MAXPATHLEN, directory ); +- if ( MAXPATHLEN < current_directory_length ) { +- FEerror ( "truename got a current directory name larger than MAXPATHLEN", 1, "" ); +- } +- if ( 0 == current_directory_length ) { +- FEerror ( "truename could not determine the current directory.", 1, "" ); +- } +- p = directory; +- if ( p[1]==':' && ( p[2]=='\\' || p[2]=='/' ) && p[3]==0 ) p[2]=0; +- q[0]=current; +- } +- else +-#endif +- { +- *q++ = '\0'; +- if (chdir(filename) < 0) +- FEerror("Cannot get the truename of ~S.", 1, pathname); +-#ifdef __MINGW32__ +- current_directory_length = GetCurrentDirectory ( MAXPATHLEN, directory ); +- if ( MAXPATHLEN < current_directory_length ) { +- FEerror ( "truename got a current directory name larger than MAXPATHLEN", 1, "" ); +- } +- if ( 0 == current_directory_length ) { +- FEerror ( "truename could not determine the current directory.", 1, "" ); +- } +- p = directory; +-#else +- p = getcwd(directory,sizeof(directory)); +-#endif +- } +- if (p[0] == '/' && p[1] == '\0') { +- if (strcmp(q, "..") == 0) +- strcpy(truefilename, "/."); +- else +- sprintf(truefilename, "/%s", q); +- } else if (strcmp(q, ".") == 0) +- strcpy(truefilename, p); +- else if (strcmp(q, "..") == 0) { +- for (q = p + strlen(p); *--q != '/';) ; +- if (p == q) +- strcpy(truefilename, "/."); +- else { +- *q = '\0'; +- strcpy(truefilename, p); +- *q = '/'; +- } +- } else +- sprintf(truefilename, "%s/%s", p, q); +- massert(!chdir(current_directory)); +- vs_push(make_simple_string(truefilename)); +- pathname = coerce_to_pathname(vs_head); +- vs_popp; +- return(pathname); +-} + object sSAallow_gzipped_fileA; + + bool +@@ -429,41 +321,6 @@ file_len(FILE *fp) + else return 0; + } + +-LFD(Ltruename)(void) +-{ +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = truename(vs_base[0]); +-} +- +-LFD(Lrename_file)(void) +-{ +- char filename[MAXPATHLEN]; +- char newfilename[MAXPATHLEN]; +- +- check_arg(2); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- check_type_or_Pathname_string_symbol(&vs_base[1]); +- coerce_to_filename(vs_base[0], filename); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_base[1] = coerce_to_pathname(vs_base[1]); +- vs_base[1] = merge_pathnames(vs_base[1], vs_base[0], Cnil); +- coerce_to_filename(vs_base[1], newfilename); +-#ifdef HAVE_RENAME +- if (rename(filename, newfilename) < 0) +- FEerror("Cannot rename the file ~S to ~S.", +- 2, vs_base[0], vs_base[1]); +-#else +- sprintf(command, "mv %s %s", filename, newfilename); +- msystem(command); +-#endif +- vs_push(vs_base[1]); +- vs_push(truename(vs_base[0])); +- vs_push(truename(vs_base[1])); +- vs_base += 2; +-} +- +- + DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); + DEF_ORDINARY("LINK",sKlink,KEYWORD,""); + DEF_ORDINARY("FILE",sKfile,KEYWORD,""); +@@ -500,33 +357,28 @@ int gcl_putc(int i,void *v) {return putc + + + +-DEFUN_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object path),"") { ++DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + +- char filename[4096]; + struct stat ss; +- + +- bzero(filename,sizeof(filename)); +- coerce_to_filename(path,filename); ++ check_type_string(&x); ++ coerce_to_filename(x,FN1); ++ + #ifdef __MINGW32__ + { +- char *p=filename+strlen(filename)-1; +- for (;p>filename && *p=='/';p--) ++ char *p=FN1+strlen(FN1)-1; ++ for (;p>FN1 && *p=='/';p--) + *p=0; + } + #endif +- if (lstat(filename,&ss)) ++ if (lstat(FN1,&ss)) + RETURN1(Cnil); +- else {/* ctime_r insufficiently portable */ +- /* int j; +- ctime_r(&ss.st_ctime,filename); +- j=strlen(filename); +- if (isspace(filename[j-1])) +- filename[j-1]=0;*/ +- RETURN1(list(3,S_ISDIR(ss.st_mode) ? sKdirectory : +- (S_ISLNK(ss.st_mode) ? sKlink : sKfile), +- make_fixnum(ss.st_size),make_fixnum(ss.st_ctime))); +- } ++ else ++ RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : ++ (S_ISLNK(ss.st_mode) ? sKlink : sKfile), ++ make_fixnum(ss.st_size), ++ make_fixnum(ss.st_ctime), ++ make_fixnum(ss.st_uid)); + } + + DEFUN_NEW("SETENV",object,fSsetenv,SI,2,2,NONE,OO,OO,OO,OO,(object variable,object value),"Set environment VARIABLE to VALUE") +@@ -551,266 +403,6 @@ DEFUN_NEW("SETENV",object,fSsetenv,SI,2, + RETURN1((res == 0 ? Ct : Cnil )); + } + +-DEFUNO_NEW("DELETE-FILE",object,fLdelete_file,LISP +- ,1,1,NONE,OO,OO,OO,OO,void,Ldelete_file,(object path),"") +- +-{ +- char filename[MAXPATHLEN]; +- +- /* 1 args */ +- check_type_or_pathname_string_symbol_stream(&path); +- coerce_to_filename(path, filename); +- if (unlink(filename) < 0 && rmdir(filename) < 0) +- FEerror("Cannot delete the file ~S: ~s.", 2, path, make_simple_string(strerror(errno))); +- path = Ct; +- RETURN1(path); +-} +-#ifdef STATIC_FUNCTION_POINTERS +-object +-fLdelete_file(object path) { +- return FFN(fLdelete_file)(path); +-} +-#endif +- +-LFD(Lprobe_file)(void) +-{ +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- if (file_exists(vs_base[0])) +- vs_base[0] = truename(vs_base[0]); +- else +- vs_base[0] = Cnil; +-} +- +-LFD(Lfile_write_date)(void) +-{ +- char filename[MAXPATHLEN]; +- struct stat filestatus; +- +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- coerce_to_filename(vs_base[0], filename); +- if (stat(filename, &filestatus) < 0 || S_ISDIR(filestatus.st_mode)) +- { vs_base[0] = Cnil; return;} +- vs_base[0] = unix_time_to_universal_time(filestatus.st_mtime); +-} +- +-LFD(Lfile_author)(void) +-{ +-#if !defined(NO_PWD_H) && !defined(STATIC_LINKING) +- char filename[MAXPATHLEN]; +- struct stat filestatus; +- struct passwd *pwent; +-#ifndef __STDC__ +- extern struct passwd *getpwuid(); +-#endif +- +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- coerce_to_filename(vs_base[0], filename); +- if (stat(filename, &filestatus) < 0 || S_ISDIR(filestatus.st_mode)) +- { vs_base[0] = Cnil; return;} +- pwent = getpwuid(filestatus.st_uid); +- vs_base[0] = make_simple_string(pwent->pw_name); +-#else +- vs_base[0] = Cnil; return; +-#endif +- +-} +- +-static void +-FFN(Luser_homedir_pathname)(void) +-{ +- +- char filename[MAXPATHLEN]; +- +- coerce_to_filename(make_simple_string("~/"),filename); +- vs_base[0]=coerce_to_pathname(make_simple_string(filename)); +- vs_top = vs_base+1; +- +-} +- +- +-#ifdef BSD +-LFD(Ldirectory)(void) +-{ +- char filename[MAXPATHLEN]; +- char command[MAXPATHLEN * 2]; +- FILE *fp; +- register int i, c; +- object *top = vs_top; +- char iobuffer[BUFSIZ]; +- extern FILE *popen(const char *, const char *); +- +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- if (vs_base[0]->pn.pn_name==Cnil && vs_base[0]->pn.pn_type==Cnil) { +- coerce_to_filename(vs_base[0], filename); +- strcat(filename, "*"); +- } else if (vs_base[0]->pn.pn_name==Cnil) { +- vs_base[0]->pn.pn_name = sKwild; +- coerce_to_filename(vs_base[0], filename); +- vs_base[0]->pn.pn_name = Cnil; +- } else if (vs_base[0]->pn.pn_type==Cnil) { +- coerce_to_filename(vs_base[0], filename); +- strcat(filename, "*"); +- } else +- coerce_to_filename(vs_base[0], filename); +- sprintf(command, "ls -d %s 2> /dev/null", filename); +- fp = popen(command, "r"); +- setbuf(fp, iobuffer); +- for (;;) { +- for (i = 0; (c = getc(fp)); i++) +- if (c <= 0) +- goto L; +- else if (c == '\n') +- break; +- else +- filename[i] = c; +- filename[i] = '\0'; +- vs_push(make_simple_string(filename)); +- vs_head = truename(vs_head); +- } +-L: +- pclose(fp); +- vs_push(Cnil); +- while (vs_top > top + 1) +- stack_cons(); +- vs_base = top; +-} +-#endif +- +- +-#ifdef ATT +-LFD(Ldirectory)() +-{ +- object name, type; +- char filename[MAXPATHLEN]; +- FILE *fp; +- object *top = vs_top; +- char iobuffer[BUFSIZ]; +- struct direct dir; +- int i; +- +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_push(vs_base[0]->pn.pn_name); +- vs_push(vs_base[0]->pn.pn_type); +- vs_base[0]->pn.pn_name = Cnil; +- vs_base[0]->pn.pn_type = Cnil; +- coerce_to_filename(vs_base[0], filename); +- type = vs_base[0]->pn.pn_type = vs_pop; +- name = vs_base[0]->pn.pn_name = vs_pop; +- i = strlen(filename); +- if (i > 1 && filename[i-1] == '/') +- filename[i-1] = '\0'; +- if (i == 0) +- strcpy(filename, "."); +- fp = fopen(filename, "r"); +- if (fp == NULL) { +- vs_push(make_simple_string(filename)); +- FEerror("Can't open the directory ~S.", 1, vs_head); +- } +- setbuf(fp, iobuffer); +- fread(&dir, sizeof(struct direct), 1, fp); +- fread(&dir, sizeof(struct direct), 1, fp); +- filename[DIRSIZ] = '\0'; +- for (;;) { +- if (fread(&dir, sizeof(struct direct), 1, fp) <=0) +- break; +- if (dir.d_ino == 0) +- continue; +- strncpy(filename, dir.d_name, DIRSIZ); +- vs_push(make_simple_string(filename)); +- vs_head = coerce_to_pathname(vs_head); +- if ((name == Cnil || name == sKwild || +- equal(name, vs_head->pn.pn_name)) && +- (type == Cnil || type == sKwild || +- equal(type, vs_head->pn.pn_type))) { +- vs_head->pn.pn_directory +- = vs_base[0]->pn.pn_directory; +- vs_head = truename(vs_head); +- } else +- vs_pop; +- } +- fclose(fp); +- vs_push(Cnil); +- while (vs_top > top + 1) +- stack_cons(); +- vs_base = top; +-} +-#endif +- +- +-#ifdef E15 +-#include +- +-LFD(Ldirectory)() +-{ +- object name, type; +- char filename[MAXPATHLEN]; +- FILE *fp; +- object *top = vs_top; +- char iobuffer[BUFSIZ]; +- struct direct dir; +- int i; +- +- check_arg(1); +- +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- vs_base[0] = coerce_to_pathname(vs_base[0]); +- vs_push(vs_base[0]->pn.pn_name); +- vs_push(vs_base[0]->pn.pn_type); +- vs_base[0]->pn.pn_name = Cnil; +- vs_base[0]->pn.pn_type = Cnil; +- coerce_to_filename(vs_base[0], filename); +- type = vs_base[0]->pn.pn_type = vs_pop; +- name = vs_base[0]->pn.pn_name = vs_pop; +- i = strlen(filename); +- if (i > 1 && filename[i-1] == '/') +- filename[i-1] = '\0'; +- if (i == 0) +- strcpy(filename, "."); +- fp = fopen(filename, "r"); +- if (fp == NULL) { +- vs_push(make_simple_string(filename)); +- FEerror("Can't open the directory ~S.", 1, vs_head); +- } +- setbuf(fp, iobuffer); +- fread(&dir, sizeof(struct direct), 1, fp); +- fread(&dir, sizeof(struct direct), 1, fp); +- filename[DIRSIZ] = '\0'; +- for (;;) { +- if (fread(&dir, sizeof(struct direct), 1, fp) <=0) +- break; +- if (dir.d_ino == 0) +- continue; +- strncpy(filename, dir.d_name, DIRSIZ); +- vs_push(make_simple_string(filename)); +- vs_head = coerce_to_pathname(vs_head); +- if ((name == Cnil || name == sKwild || +- equal(name, vs_head->pn.pn_name)) && +- (type == Cnil || type == sKwild || +- equal(type, vs_head->pn.pn_type))) { +- vs_head->pn.pn_directory +- = vs_base[0]->pn.pn_directory; +- vs_head = truename(vs_head); +- } else +- vs_pop; +- } +- fclose(fp); +- vs_push(Cnil); +- while (vs_top > top + 1) +- stack_cons(); +- vs_base = top; +-} +-#endif +- + #include + #include + +@@ -840,17 +432,31 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_ + } + #endif + +-DEFUN_NEW("READDIR",object,fSreaddir,SI,2,2,NONE,OI,IO,OO,OO,(fixnum x,fixnum y),"") { ++DEFUN_NEW("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,object s),"") { + struct dirent *e; + object z; ++ long tl; ++ size_t l; + if (!x) RETURN1(Cnil); +- e=readdir((DIR *)x); +- RETURN1(e ? make_simple_string(e->d_name) : Cnil); ++ tl=telldir((DIR *)x); + #ifdef HAVE_D_TYPE + for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); + #endif + if (!e) RETURN1(Cnil); +- z=make_simple_string(e->d_name); ++ if (s==Cnil) ++ z=make_simple_string(e->d_name); ++ else { ++ check_type_string(&s); ++ l=strlen(e->d_name); ++ if (s->st.st_dim-s->st.st_fillp>=l) { ++ memcpy(s->st.st_self+s->st.st_fillp,e->d_name,l); ++ s->st.st_fillp+=l; ++ z=s; ++ } else { ++ seekdir((DIR *)x,tl); ++ RETURN1(make_fixnum(l)); ++ } ++ } + #ifdef HAVE_D_TYPE + if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type)); + #endif +@@ -882,7 +488,126 @@ DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1, + + } + ++DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_string(&x); ++ ++ coerce_to_filename(x,FN1); ++ ++ RETURN1(rmdir(FN1) ? Cnil : Ct); ++ ++} ++ ++ ++ ++#include ++#include ++#include ++#include ++ ++DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { ++ char *b1,*b2=NULL; ++ ssize_t l,z1,z2; ++ check_type_string(&s); ++ /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ ++ z1=length(s); ++ massert((b1=alloca(z1+1))); ++ memcpy(b1,s->st.st_self,z1); ++ b1[z1]=0; ++ for (l=z2=0;l>=z2;) { ++ memset(b2,0,z2); ++ z2+=z2+10; ++ massert((b2=alloca(z2))); ++ massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,b1,b2,z2))>=0); ++ } ++ b2[l]=0; ++ s=make_simple_string(b2); ++ memset(b1,0,z1); ++ memset(b2,0,z2); ++ RETURN1(s); ++} ++ ++DEFUN_NEW("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { ++ char *b=NULL; ++ size_t z; ++ object s; ++ ++ for (z=0;!(errno=0) && !getcwd(b,z) && errno==ERANGE;b=memset(b,0,z),z+=z+10,({massert((b=alloca(z)));})); ++ massert((b=getcwd(b,z))); ++ s=make_simple_string(b); ++ memset(b,0,z); ++ RETURN1(s); ++ ++} ++ ++DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { ++ struct passwd *pwent,pw; ++ char *b; ++ long r; ++ ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++ massert(b=alloca(r)); ++ ++ massert(!getpwuid_r(uid,&pw,b,r,&pwent)); ++ ++ RETURN1(make_simple_string(pwent->pw_name)); ++ ++} ++ ++DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { ++ ++ struct passwd *pwent,pw; ++ char *b; ++ long r; ++ ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++ massert(b=alloca(r)); + ++ if (nm->st.st_fillp==1) ++ ++ if ((pw.pw_dir=getenv("HOME"))) ++ pwent=&pw; ++ else ++ massert(!getpwuid_r(getuid(),&pw,b,r,&pwent)); ++ ++ else { ++ ++ char *name; ++ ++ massert(name=alloca(nm->st.st_fillp)); ++ memcpy(name,nm->st.st_self+1,nm->st.st_fillp-1); ++ name[nm->st.st_fillp-1]=0; ++ ++ massert(!getpwnam_r(name,&pw,b,r,&pwent)); ++ ++ } ++ ++ massert((b=alloca(strlen(pwent->pw_dir)+2))); ++ memcpy(b,pwent->pw_dir,strlen(pwent->pw_dir)); ++ b[strlen(pwent->pw_dir)]='/'; ++ b[strlen(pwent->pw_dir)+1]=0; ++ RETURN1(make_simple_string(b)); ++ ++} ++ ++DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ ++ check_type_string(&x); ++ check_type_string(&y); ++ ++ coerce_to_filename(x,FN1); ++ coerce_to_filename(y,FN2); ++ ++ RETURN1(rename(FN1,FN2) ? Cnil : Ct); ++ ++} ++ ++DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ ++ coerce_to_filename(x,FN1); ++ ++ RETURN1(unlink(FN1) ? Cnil : Ct); ++ ++} + + + static void +@@ -900,16 +625,8 @@ FFN(siLchdir)(void) + } + + void +-gcl_init_unixfsys(void) +-{ +- make_function("TRUENAME", Ltruename); +- make_function("RENAME-FILE", Lrename_file); +- make_function("DELETE-FILE", Ldelete_file); +- make_function("PROBE-FILE", Lprobe_file); +- make_function("FILE-WRITE-DATE", Lfile_write_date); +- make_function("FILE-AUTHOR", Lfile_author); +- make_function("USER-HOMEDIR-PATHNAME", Luser_homedir_pathname); +- make_function("DIRECTORY", Ldirectory); ++gcl_init_unixfsys(void) { ++ ++ make_si_function("CHDIR", siLchdir); + +- make_si_function("CHDIR", siLchdir); + } +--- gcl-2.6.12.orig/o/usig.c ++++ gcl-2.6.12/o/usig.c +@@ -148,13 +148,15 @@ DEFUN_NEW("FLD",object,fSfld,SI,1,1,NONE + + #endif + +-DEFUN_NEW("*FIXNUM",fixnum,fSAfixnum,SI,1,1,NONE,II,OO,OO,OO,(fixnum addr),"") { +- RETURN1(*(fixnum *)addr); ++/* For now ignore last three args governing offsets and data modification, just to ++ support fpe sync with master*/ ++DEFUN_NEW("*FIXNUM",object,fSAfixnum,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { ++ RETURN1((object)*(fixnum *)addr); + } +-DEFUN_NEW("*FLOAT",object,fSAfloat,SI,1,1,NONE,OI,OO,OO,OO,(fixnum addr),"") { ++DEFUN_NEW("*FLOAT",object,fSAfloat,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { + RETURN1(make_shortfloat(*(float *)addr)); + } +-DEFUN_NEW("*DOUBLE",object,fSAdouble,SI,1,1,NONE,OI,OO,OO,OO,(fixnum addr),"") { ++DEFUN_NEW("*DOUBLE",object,fSAdouble,SI,4,4,NONE,OI,OO,OO,OO,(fixnum addr,object x,object y,object z),"") { + RETURN1(make_longfloat(*(double *)addr)); + } + +@@ -264,7 +266,6 @@ sigpipe(void) + FEerror("Broken pipe", 0); + } + +- + void + sigint(void) + { +@@ -272,8 +273,6 @@ sigint(void) + terminal_interrupt(1); + } + +- +- + static void + sigalrm(void) + { +--- gcl-2.6.12.orig/unixport/sys_ansi_gcl.c ++++ gcl-2.6.12/unixport/sys_ansi_gcl.c +@@ -41,7 +41,6 @@ gcl_init_system(object no_init) + #ifdef HAVE_JAPI_H + ar_check_init(gcl_japi,no_init); + #endif +- ar_check_init(gcl_iolib,no_init); + ar_check_init(gcl_listlib,no_init); + ar_check_init(gcl_mislib,no_init); + ar_check_init(gcl_numlib,no_init); +@@ -56,9 +55,23 @@ gcl_init_system(object no_init) + ar_check_init(gcl_defpackage,no_init); + ar_check_init(gcl_make_defpackage,no_init); + ar_check_init(gcl_sharp,no_init); +- ar_check_init(gcl_fpe,no_init); + ++ ar_check_init(gcl_sharp_uv,no_init); ++ ar_check_init(gcl_namestring,no_init); ++ ar_check_init(gcl_logical_pathname_translations,no_init); ++ ar_check_init(gcl_make_pathname,no_init); ++ ar_check_init(gcl_parse_namestring,no_init); ++ ar_check_init(gcl_translate_pathname,no_init); ++ ar_check_init(gcl_directory,no_init); ++ ar_check_init(gcl_merge_pathnames,no_init); ++ ar_check_init(gcl_truename,no_init); ++ ar_check_init(gcl_rename_file,no_init); ++ ar_check_init(gcl_wild_pathname_p,no_init); ++ ar_check_init(gcl_pathname_match_p,no_init); + ++ ar_check_init(gcl_iolib,no_init); ++ ar_check_init(gcl_fpe,no_init); ++ + ar_check_init(gcl_cmpinline,no_init); + ar_check_init(gcl_cmputil,no_init); + +@@ -107,6 +120,7 @@ gcl_init_system(object no_init) + ar_check_init(gcl_index,no_init); + #endif + ++ lsp_init("../pcl/package.lisp"); + ar_check_init(gcl_pcl_pkg,no_init); + ar_check_init(gcl_pcl_walk,no_init); + ar_check_init(gcl_pcl_iterate,no_init); +@@ -142,6 +156,7 @@ gcl_init_system(object no_init) + ar_check_init(gcl_pcl_precom1,no_init); + ar_check_init(gcl_pcl_precom2,no_init); + ++ lsp_init("../clcs/package.lisp"); + ar_check_init(gcl_clcs_precom,no_init); + ar_check_init(gcl_clcs_handler,no_init); + ar_check_init(gcl_clcs_conditions,no_init); +--- gcl-2.6.12.orig/unixport/sys_gcl.c ++++ gcl-2.6.12/unixport/sys_gcl.c +@@ -34,7 +34,6 @@ gcl_init_system(object no_init) { + #ifdef HAVE_JAPI_H + ar_check_init(gcl_japi,no_init); + #endif +- ar_check_init(gcl_iolib,no_init); + ar_check_init(gcl_listlib,no_init); + ar_check_init(gcl_mislib,no_init); + ar_check_init(gcl_numlib,no_init); +@@ -49,9 +48,23 @@ gcl_init_system(object no_init) { + ar_check_init(gcl_defpackage,no_init); + ar_check_init(gcl_make_defpackage,no_init); + ar_check_init(gcl_sharp,no_init); +- ar_check_init(gcl_fpe,no_init); + ++ ar_check_init(gcl_sharp_uv,no_init); ++ ar_check_init(gcl_namestring,no_init); ++ ar_check_init(gcl_logical_pathname_translations,no_init); ++ ar_check_init(gcl_make_pathname,no_init); ++ ar_check_init(gcl_parse_namestring,no_init); ++ ar_check_init(gcl_translate_pathname,no_init); ++ ar_check_init(gcl_directory,no_init); ++ ar_check_init(gcl_merge_pathnames,no_init); ++ ar_check_init(gcl_truename,no_init); ++ ar_check_init(gcl_rename_file,no_init); ++ ar_check_init(gcl_wild_pathname_p,no_init); ++ ar_check_init(gcl_pathname_match_p,no_init); + ++ ar_check_init(gcl_iolib,no_init); ++ ar_check_init(gcl_fpe,no_init); ++ + ar_check_init(gcl_cmpinline,no_init); + ar_check_init(gcl_cmputil,no_init); + +--- gcl-2.6.12.orig/unixport/sys_init.lsp.in ++++ gcl-2.6.12/unixport/sys_init.lsp.in +@@ -9,9 +9,6 @@ + (in-package :system) + (use-package :fpe) + +-#+(or pcl ansi-cl)(load "../pcl/package.lisp") +-#+ansi-cl(load "../clcs/package.lisp") +- + (init-system) + (in-package :si) + (gbc t) +@@ -20,7 +17,7 @@ + (setq *link-array* (make-array (ash 1 11) :element-type 'character :fill-pointer 0))) + (use-fast-links t) + +-(let* ((x (append (pathname-directory *system-directory*) (list :parent))) ++(let* ((x (append (pathname-directory *system-directory*) (list :back))) + (lsp (append x (list "lsp"))) + (cmpnew (append x (list "cmpnew"))) + (h (append x (list "h"))) +@@ -59,6 +56,7 @@ + + (fmakunbound 'init-cmp-anon) + (when (fboundp 'user-init) (user-init)) ++ + (in-package :compiler) + (setq *cc* @LI-CC@ + *ld* @LI-LD@ +@@ -79,7 +77,9 @@ + #-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp))) + + #+ansi-cl (use-package :pcl :user) +-#+ansi-cl (import 'si::(clines defentry defcfun object void int double quit bye gbc system) :user) ++ ++(import 'si::(clines defentry defcfun object void int double quit bye gbc system ++ *lib-directory* *system-directory*) :user) + + (let* ((i 4096)(j (si::equal-tail-recursion-check i))) + (unless (<= (ash i -1) j) +--- gcl-2.6.12.orig/unixport/sys_pcl_gcl.c ++++ gcl-2.6.12/unixport/sys_pcl_gcl.c +@@ -41,7 +41,6 @@ gcl_init_system(object no_init) + #ifdef HAVE_JAPI_H + ar_check_init(gcl_japi,no_init); + #endif +- ar_check_init(gcl_iolib,no_init); + ar_check_init(gcl_listlib,no_init); + ar_check_init(gcl_mislib,no_init); + ar_check_init(gcl_numlib,no_init); +@@ -56,9 +55,23 @@ gcl_init_system(object no_init) + ar_check_init(gcl_defpackage,no_init); + ar_check_init(gcl_make_defpackage,no_init); + ar_check_init(gcl_sharp,no_init); +- ar_check_init(gcl_fpe,no_init); + ++ ar_check_init(gcl_sharp_uv,no_init); ++ ar_check_init(gcl_namestring,no_init); ++ ar_check_init(gcl_logical_pathname_translations,no_init); ++ ar_check_init(gcl_make_pathname,no_init); ++ ar_check_init(gcl_parse_namestring,no_init); ++ ar_check_init(gcl_translate_pathname,no_init); ++ ar_check_init(gcl_directory,no_init); ++ ar_check_init(gcl_merge_pathnames,no_init); ++ ar_check_init(gcl_truename,no_init); ++ ar_check_init(gcl_rename_file,no_init); ++ ar_check_init(gcl_wild_pathname_p,no_init); ++ ar_check_init(gcl_pathname_match_p,no_init); + ++ ar_check_init(gcl_iolib,no_init); ++ ar_check_init(gcl_fpe,no_init); ++ + ar_check_init(gcl_cmpinline,no_init); + ar_check_init(gcl_cmputil,no_init); + +@@ -107,6 +120,7 @@ gcl_init_system(object no_init) + ar_check_init(gcl_index,no_init); + #endif + ++ lsp_init("../pcl/package.lisp"); + ar_check_init(gcl_pcl_pkg,no_init); + ar_check_init(gcl_pcl_walk,no_init); + ar_check_init(gcl_pcl_iterate,no_init); +--- gcl-2.6.12.orig/unixport/sys_pre_gcl.c ++++ gcl-2.6.12/unixport/sys_pre_gcl.c +@@ -39,7 +39,6 @@ gcl_init_system(object no_init) + #ifdef HAVE_JAPI_H + lsp_init("../lsp/gcl_japi.lsp"); + #endif +- lsp_init("../lsp/gcl_iolib.lsp"); + /* lsp_init("../lsp/gcl_listlib.lsp"); */ + lsp_init("../lsp/gcl_mislib.lsp"); + lsp_init("../lsp/gcl_numlib.lsp"); +@@ -54,6 +53,21 @@ gcl_init_system(object no_init) + lsp_init("../lsp/gcl_defpackage.lsp"); + lsp_init("../lsp/gcl_make_defpackage.lsp"); + lsp_init("../lsp/gcl_sharp.lsp"); ++ ++ lsp_init("../lsp/gcl_sharp_uv.lsp"); ++ lsp_init("../lsp/gcl_logical_pathname_translations.lsp"); ++ lsp_init("../lsp/gcl_make_pathname.lsp"); ++ lsp_init("../lsp/gcl_parse_namestring.lsp"); ++ lsp_init("../lsp/gcl_namestring.lsp"); ++ lsp_init("../lsp/gcl_translate_pathname.lsp"); ++ lsp_init("../lsp/gcl_directory.lsp"); ++ lsp_init("../lsp/gcl_merge_pathnames.lsp"); ++ lsp_init("../lsp/gcl_truename.lsp"); ++ lsp_init("../lsp/gcl_rename_file.lsp"); ++ lsp_init("../lsp/gcl_wild_pathname_p.lsp"); ++ lsp_init("../lsp/gcl_pathname_match_p.lsp"); ++ ++ lsp_init("../lsp/gcl_iolib.lsp"); + lsp_init("../lsp/gcl_fpe.lsp"); + + lsp_init("../cmpnew/gcl_cmpinline.lsp"); +--- gcl-2.6.12.orig/xbin/make-fn ++++ gcl-2.6.12/xbin/make-fn +@@ -6,10 +6,13 @@ TMP=/tmp/tmpd$$ + mkdir ${TMP} + cp $@ ${TMP} + +-for v in $@ ; ++for v in $1 ; + do + echo '(load (format nil "~a~a" si::*system-directory* "../cmpnew/gcl_collectfn"))' \ + '(compiler::emit-fn t)'\ ++ "(compile-file \"${TMP}/$v\" :o-file nil)" ++echo '(load (format nil "~a~a" si::*system-directory* "../cmpnew/gcl_collectfn"))' \ ++ '(compiler::emit-fn t)'\ + "(compile-file \"${TMP}/$v\" :o-file nil)" | ${LISP} + done + diff --git a/patches/pathnames1.11 b/patches/pathnames1.11 new file mode 100644 index 00000000..71bab921 --- /dev/null +++ b/patches/pathnames1.11 @@ -0,0 +1,246 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-45) unstable; urgency=high + . + * pathnames1.11 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-31 + +--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp ++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp +@@ -144,7 +144,7 @@ + (DEFSYSFUN 'SVREF "Lsvref" '(T T) 'T NIL NIL) + (DEFSYSFUN 'APPLY "Lapply" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'DECODE-FLOAT "Ldecode_float" '(T) '(VALUES T T T) NIL NIL) +-(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL) ++;(DEFSYSFUN 'SUBST-IF-NOT "Lsubst_if_not" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'RPLACA "Lrplaca" '(T T) 'T NIL NIL) + (DEFSYSFUN 'SYMBOL-PLIST "Lsymbol_plist" '(T) 'T NIL NIL) + (DEFSYSFUN 'WRITE-STRING "Lwrite_string" '(T *) 'T NIL NIL) +@@ -210,7 +210,7 @@ + (DEFSYSFUN 'NSUBLIS "Lnsublis" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'CHAR-NOT-EQUAL "Lchar_not_equal" '(T *) 'T NIL T) + (DEFSYSFUN 'MACRO-FUNCTION "Lmacro_function" '(T) 'T NIL NIL) +-(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) ++;(DEFSYSFUN 'SUBST-IF "Lsubst_if" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'COMPLEXP "Lcomplexp" '(T) 'T NIL T) + (DEFSYSFUN 'READ-LINE "Lread_line" '(*) '(VALUES T T) NIL NIL) + (DEFSYSFUN 'MAX "Lmax" '(T *) 'T NIL NIL) +@@ -232,7 +232,7 @@ + (DEFSYSFUN 'FLOAT "Lfloat" '(T *) 'T NIL NIL) + ;(DEFSYSFUN 'FIRST "Lcar" '(T) 'T NIL NIL) + (DEFSYSFUN 'ROUND "Lround" '(T *) '(VALUES T T) NIL NIL) +-(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL) ++;(DEFSYSFUN 'SUBST "Lsubst" '(T T T *) 'T NIL NIL) + (DEFSYSFUN 'UPPER-CASE-P "Lupper_case_p" '(T) 'T NIL T) + (DEFSYSFUN 'ARRAY-ELEMENT-TYPE "Larray_element_type" '(T) 'T NIL NIL) + (DEFSYSFUN 'ADJOIN "Ladjoin" '(T T *) 'T NIL NIL) +--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp ++++ gcl-2.6.12/lsp/gcl_arraylib.lsp +@@ -262,8 +262,6 @@ + (static (staticp array)) + &aux (fill-pointer (or fill-pointer (when (array-has-fill-pointer-p array) (fill-pointer array))))) + +- (declare (ignore element-type)) +- + (let ((x (if initial-contents-supplied-p + (make-array new-dimensions + :adjustable t +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -80,7 +80,7 @@ + 0 l))) + + (defun get-string-input-stream-index (stream &aux (s (c-stream-object0 stream))) +- (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) b))) ++ (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) (declare (ignore a)) b))) + + (defmacro with-input-from-string ((var string &key index (start 0) end) . body) + (declare (optimize (safety 1))) +@@ -457,10 +457,10 @@ + if-exists iesp if-does-not-exist idnesp external-format))) + (when (typep s 'stream) (c-set-stream-object1 s pf) s))) + +-(defun load-pathname-exists (z) +- (or (probe-file z) +- (when *allow-gzipped-file* +- (when (probe-file (string-concatenate (namestring z) ".gz")) ++(defun load-pathname-exists (z &aux (z (link-expand (namestring z)))) ++ (cond ((eq (stat z) :file) z) ++ (*allow-gzipped-file* ++ (when (eq (stat (string-concatenate (namestring z) ".gz")) :file) + z)))) + + (defun load-pathname (p print if-does-not-exist external-format +--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp ++++ gcl-2.6.12/lsp/gcl_listlib.lsp +@@ -180,3 +180,34 @@ + (defmacro nth-value (n expr) + (declare (optimize (safety 1))) + `(nth ,n (multiple-value-list ,expr))) ++ ++(eval-when (compile eval) ++ ++ (defmacro repl-if (tc) `(labels ((l (tr &aux (k (if kf (funcall kf tr) tr))) ++ (cond (,tc n) ++ ((atom tr) tr) ++ ((let* ((ca (car tr))(a (l ca))(cd (cdr tr))(d (l cd))) ++ (if (and (eq a ca) (eq d cd)) tr (cons a d))))))) ++ (declare (ftype (function (t) t) l)) ++ (l tr)))) ++ ++(defun subst (n o tr &key key test test-not ++ &aux (kf (when key (coerce key 'function))) ++ (tf (when test (coerce test 'function))) ++ (ntf (when test-not (coerce test-not 'function)))) ++ (declare (optimize (safety 1))) ++ (check-type key (or null function)) ++ (check-type test (or null function)) ++ (check-type test-not (or null function)) ++ (repl-if (cond (tf (funcall tf o k))(ntf (not (funcall ntf o k)))((eql o k))))) ++ ++(defun subst-if (n p tr &key key &aux (kf (when key (coerce key 'function)))) ++ (declare (optimize (safety 1))) ++ (check-type p function) ++ (check-type key (or null function)) ++ (repl-if (funcall p k))) ++(defun subst-if-not (n p tr &key key &aux (kf (when key (coerce key 'function)))) ++ (declare (optimize (safety 1))) ++ (check-type p function) ++ (check-type key (or null function)) ++ (repl-if (not (funcall p k))))) +--- gcl-2.6.12.orig/lsp/gcl_truename.lsp ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -23,7 +23,8 @@ + (check-type pd pathname-designator) + (when (wild-pathname-p ns) + (error 'file-error :pathname pd :format-control "Pathname is wild")) +- (let* ((ns (ensure-dir-string (link-expand ns)))(ppd (pathname ns))) ++ (let* ((ns (ensure-dir-string (link-expand ns))) ++ (ppd (if (eq (namestring pd) ns) pd (pathname ns)))) + (unless (or (zerop (length ns)) (stat ns)) + (error 'file-error :pathname ns :format-control "Pathname does not exist")) + (let* ((d (pathname-directory ppd)) +--- gcl-2.6.12.orig/o/list.d ++++ gcl-2.6.12/o/list.d +@@ -528,26 +528,26 @@ object x; + vs_check_push(x); + } + +-/* +- Subst(new, tree) pushes +- the result of substituting new in tree +- onto vs. +-*/ +-static void +-subst(new, tree) +-object new, tree; +-{ +- cs_check(new); +- +- if (TEST(tree)) +- vs_check_push(new); +- else if (type_of(tree) == t_cons) { +- subst(new, tree->c.c_car); +- subst(new, tree->c.c_cdr); +- stack_cons(); +- } else +- vs_check_push(tree); +-} ++/* /\* */ ++/* Subst(new, tree) pushes */ ++/* the result of substituting new in tree */ ++/* onto vs. */ ++/* *\/ */ ++/* static void */ ++/* subst(new, tree) */ ++/* object new, tree; */ ++/* { */ ++/* cs_check(new); */ ++ ++/* if (TEST(tree)) */ ++/* vs_check_push(new); */ ++/* else if (type_of(tree) == t_cons) { */ ++/* subst(new, tree->c.c_car); */ ++/* subst(new, tree->c.c_cdr); */ ++/* stack_cons(); */ ++/* } else */ ++/* vs_check_push(tree); */ ++/* } */ + + /* static object */ + /* subst1(object new, object tree) { */ +@@ -1153,25 +1153,25 @@ LFD(Lrplacd)() + vs_popp; + } + +-@(defun subst (new old tree &key test test_not key) +- saveTEST; +-@ +- protectTEST; +- setupTEST(old, test, test_not, key); +- subst(new, tree); +- tree = vs_pop; +- /* if (kf==identity && */ +- /* tf==test_eql && */ +- /* (is_imm_fixnum(item_compared) || */ +- /* ({enum type tp=type_of(item_compared);tp>t_complex || tpt_complex || tp + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-46) unstable; urgency=high + . + * pathnames1.12 + * Bug fix: "maintainer script(s) do not start on #!", thanks to + treinen@debian.org; (Closes: #843303). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/843303 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-11-18 + +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -457,11 +457,10 @@ + if-exists iesp if-does-not-exist idnesp external-format))) + (when (typep s 'stream) (c-set-stream-object1 s pf) s))) + +-(defun load-pathname-exists (z &aux (z (link-expand (namestring z)))) +- (cond ((eq (stat z) :file) z) +- (*allow-gzipped-file* +- (when (eq (stat (string-concatenate (namestring z) ".gz")) :file) +- z)))) ++(defun load-pathname-exists (z) ++ (or (probe-file z) ++ (when *allow-gzipped-file* ++ (probe-file (string-concatenate (namestring z) ".gz"))))) + + (defun load-pathname (p print if-does-not-exist external-format + &aux (pp (merge-pathnames p)) +--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp ++++ gcl-2.6.12/lsp/gcl_listlib.lsp +@@ -123,8 +123,8 @@ + + (defun smallnthcdr (n x) + (declare (fixnum n)) +- (cond ((atom x) (when x (tp-error x proper-list))) +- ((= n 0) x) ++ (cond ((= n 0) x) ++ ((atom x) (when x (tp-error x proper-list))) + ((smallnthcdr (1- n) (cdr x))))) + + (defun bignthcdr (n i s f) +--- gcl-2.6.12.orig/lsp/gcl_truename.lsp ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -38,5 +38,5 @@ + (check-type pd pathname-designator) + (when (wild-pathname-p pn) + (error 'file-error :pathname pn :format-control "Pathname is wild")) +- (when (eq (stat (namestring pn)) :file) ++ (when (eq (stat (link-expand (namestring pn))) :file) + (truename pn))) diff --git a/patches/pathnames1.13 b/patches/pathnames1.13 new file mode 100644 index 00000000..57073da4 --- /dev/null +++ b/patches/pathnames1.13 @@ -0,0 +1,40 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-46) unstable; urgency=high + . + * pathnames1.12 + * Bug fix: "maintainer script(s) do not start on #!", thanks to + treinen@debian.org; (Closes: #843303). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/843303 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-11-22 + +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -460,7 +460,8 @@ + (defun load-pathname-exists (z) + (or (probe-file z) + (when *allow-gzipped-file* +- (probe-file (string-concatenate (namestring z) ".gz"))))) ++ (when (probe-file (string-concatenate (namestring z) ".gz")) ++ z)))) + + (defun load-pathname (p print if-does-not-exist external-format + &aux (pp (merge-pathnames p)) diff --git a/patches/pathnames1.2 b/patches/pathnames1.2 new file mode 100644 index 00000000..f7bb1114 --- /dev/null +++ b/patches/pathnames1.2 @@ -0,0 +1,1196 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-39) unstable; urgency=medium + . + * pathnames1.1 + * ansi-test clean target +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-12 + +--- gcl-2.6.12.orig/h/notcomp.h ++++ gcl-2.6.12/h/notcomp.h +@@ -296,6 +296,8 @@ gcl_init_cmp_anon(void); + + char FN1[PATH_MAX],FN2[PATH_MAX],FN3[PATH_MAX],FN4[PATH_MAX],FN5[PATH_MAX]; + ++#define coerce_to_filename(a_,b_) coerce_to_filename1(a_,b_,sizeof(b_)) ++ + #include + #define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);}) + +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -508,7 +508,7 @@ typedef void (*funcvoid)(void); + /* unexlin.c:808:OF */ extern int write_segment (int new, register char *ptr, register char *end); /* (new, ptr, end) int new; register char *ptr; register char *end; */ + /* unixfasl.c:409:OF */ extern void gcl_init_unixfasl (void); /* () */ + /* unixfsys.c:145:OF */ extern char *getwd (char *buffer); /* (buffer) char *buffer; */ +-/* unixfsys.c:209:OF */ extern void coerce_to_filename (object pathname, char *p); /* (pathname, p) object pathname; char *p; */ ++/* unixfsys.c:209:OF */ extern void coerce_to_filename1 (object pathname, char *p,unsigned sz); /* (pathname, p) object pathname; char *p; */ + /* unixfsys.c:329:OF */ extern bool file_exists (object file); /* (file) object file; */ + /* unixfsys.c:359:OF */ extern FILE *backup_fopen (char *filename, char *option); /* (filename, option) char *filename; char *option; */ + /* unixfsys.c:359:OF */ extern FILE *fopen_not_dir (char *filename, char *option); /* (filename, option) char *filename; char *option; */ +--- gcl-2.6.12.orig/lsp/gcl_directory.lsp ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -48,8 +48,12 @@ + (expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME + ((funcall f z y)))))) + ++(defun chdir (s) ++ (when (chdir1 (namestring (pathname s)));to expand ~/ ++ (setq *current-directory* (current-directory-pathname)))) ++ + (defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) +- (c (unless (eq (car d) :absolute) (make-frame (concatenate 'string (getcwd) "/")))) ++ (c (unless (eq (car d) :absolute) (make-frame (namestring *current-directory*)))) + (lc (when c (length c))) + (filesp (or (pathname-name p) (pathname-type p))) + (v (compile-regexp (to-regexp p)))(*up-key* :back) r) +--- gcl-2.6.12.orig/lsp/gcl_rename_file.lsp ++++ gcl-2.6.12/lsp/gcl_rename_file.lsp +@@ -35,6 +35,7 @@ + (check-type spec pathname-designator) + (multiple-value-bind + (tp sz tm) (stat (namestring (truename spec))) ++ (declare (ignore tp sz)) + (+ tm (* (+ 17 (* 70 365)) (* 24 60 60))))) + + +@@ -43,5 +44,6 @@ + (check-type spec pathname-designator) + (multiple-value-bind + (tp sz tm uid) (stat (namestring (truename spec))) ++ (declare (ignore tp sz tm)) + (uid-to-name uid))) + +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -607,8 +607,13 @@ First directory is checked for first nam + (defvar *ld* "ld") + (defvar *objdump* "objdump --source ") + ++(defvar *current-directory* *system-directory*) ++ ++(defun current-directory-pathname nil (pathname (concatenate 'string (getcwd) "/"))) ++ + (defun set-up-top-level (&aux (i (argc)) tem) + (declare (fixnum i)) ++ (setq *current-directory* (current-directory-pathname)) + (setq *tmp-dir* (get-temp-dir) + *cc* (get-path *cc*) + *ld* (get-path *ld*) +--- gcl-2.6.12.orig/lsp/gcl_truename.lsp ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -18,20 +18,18 @@ + (pathname (typep x 'logical-pathname)) + (stream (logical-pathname-designator-p (pathname x))))) + +-;(defvar *current-dir* (pathname (concatenate 'string (getcwd) "/"))) FIXME sync with chdir +- +-(defun truename (pd &aux (ppd (translate-logical-pathname pd))(ns (namestring ppd))) ++(defun truename (pd &aux (ns (namestring (translate-logical-pathname pd)))) + (declare (optimize (safety 1))) + (check-type pd pathname-designator) + (when (wild-pathname-p ns) + (error 'file-error :pathname pd :format-control "Pathname is wild")) +- (let* ((ns (ensure-dir-string (link-expand ns)))) ++ (let* ((ns (ensure-dir-string (link-expand ns)))(ppd (pathname ns))) + (unless (or (zerop (length ns)) (stat ns)) + (error 'file-error :pathname ns :format-control "Pathname does not exist")) + (let* ((d (pathname-directory ppd)) + (d1 (subst :back :up d)) + (ppd (if (eq d d1) ppd (make-pathname :directory d1 :defaults ppd)))) +- (if (eq (car d) :absolute) ppd (merge-pathnames ppd (concatenate 'string (getcwd) "/") nil))))) ++ (if (eq (car d) :absolute) ppd (merge-pathnames ppd *current-directory* nil))))) + + + (defun probe-file (pd &aux (pn (translate-logical-pathname pd))) +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -351,120 +351,86 @@ open_stream(object fn,enum smmode smm, o + vs_mark; + + coerce_to_filename(fn,FN1); +- if (smm == smm_input || smm == smm_probe) { +- if(FN1[0]=='|') +- fp = popen(FN1+1,"r"); +- else +- fp = fopen_not_dir(FN1, "r"); + +- if ((fp == NULL) && +- (sSAallow_gzipped_fileA->s.s_dbind != sLnil)) { +- union lispunion st; +- char buf[256]; +- if (snprintf(buf,sizeof(buf),"%s.gz",FN1)<=0) +- FEerror("Cannot write .gz filename",0); +- st.st.st_self=buf; +- st.st.st_dim=st.st.st_fillp=strlen(buf); +- set_type_of(&st,t_string); +- if (fSstat((object)&st)!=Cnil) { ++ switch(smm) { ++ ++ case smm_input: ++ case smm_probe: ++ ++ if (!(fp=*FN1=='|' ? popen(FN1+1,"r") : fopen_not_dir(FN1,"r")) && sSAallow_gzipped_fileA->s.s_dbind!=Cnil) { ++ ++ struct stat ss; ++ massert(snprintf(FN2,sizeof(FN2),"%s.gz",FN1)>0); ++ ++ if (!stat(FN2,&ss)) { ++ + FILE *pp; + int n; +- if (!(fp=tmpfile())) +- FEerror("Cannot create temporary file",0); +- if (snprintf(buf,sizeof(buf),"zcat %s.gz",FN1)<=0) +- FEerror("Cannot write zcat pipe name",0); +- if (!(pp=popen(buf,"r"))) +- FEerror("Cannot open zcat pipe",0); +- while((n=fread(buf,1,sizeof(buf),pp))) +- if (!fwrite(buf,1,n,fp)) +- FEerror("Cannot write pipe output to temporary file",0); +- if (pclose(pp)<0) +- FEerror("Cannot close zcat pipe",0); +- if (fseek(fp,0,SEEK_SET)) +- FEerror("Cannot rewind temporary file\n",0); ++ ++ massert((fp=tmpfile())); ++ massert(snprintf(FN3,sizeof(FN2),"zcat %s",FN2)>0); ++ massert(pp=popen(FN3,"r")); ++ while ((n=fread(FN4,1,sizeof(FN3),pp))) ++ massert(fwrite(FN4,1,n,fp)==n); ++ massert(pclose(pp)>=0); ++ massert(!fseek(fp,0,SEEK_SET)); ++ + } ++ + } +- if (fp == NULL) { +- if (if_does_not_exist == sKerror) +- cannot_open(fn); +- else if (if_does_not_exist == sKcreate) { +- fp = fopen_not_dir(FN1, "w"); +- if (fp == NULL) +- cannot_create(fn); ++ ++ if (!fp) { ++ ++ if (if_does_not_exist==sKerror) cannot_open(fn); ++ else if (if_does_not_exist==sKcreate) { ++ if (!(fp=fopen_not_dir(FN1,"w"))) cannot_create(fn); + fclose(fp); +- fp = fopen_not_dir(FN1, "r"); +- if (fp == NULL) +- cannot_open(fn); +- } else if (if_does_not_exist == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", +- 1, if_does_not_exist); ++ if (!(fp=fopen_not_dir(FN1,"r"))) cannot_open(fn); ++ } else if (if_does_not_exist==Cnil) return(Cnil); ++ else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist); ++ + } +- } else if (smm == smm_output || smm == smm_io) { +- if (FN1[0] == '|') +- fp = NULL; +- else +- fp = fopen_not_dir(FN1, "r"); +- if (fp != NULL) { ++ break; ++ ++ case smm_output: ++ case smm_io: ++ ++ if ((fp=*FN1=='|' ? NULL : fopen_not_dir(FN1,"r"))) { ++ + fclose(fp); +- if (if_exists == sKerror) +- FILE_ERROR(fn,"File exists"); +- else if (if_exists == sKrename) { ++ if (if_exists==sKerror) FILE_ERROR(fn,"File exists"); ++ else if (if_exists==sKrename) { + massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0); + massert(!rename(FN1,FN2)); +- if (smm == smm_output) +- fp = fopen(FN1, "w"); +- else +- fp = fopen(FN1, "w+"); +- if (fp == NULL) +- cannot_create(fn); +- } else if (if_exists == sKrename_and_delete || +- if_exists == sKnew_version || +- if_exists == sKsupersede) { +- if (smm == smm_output) +- fp = fopen_not_dir(FN1, "w"); +- else +- fp = fopen_not_dir(FN1, "w+"); +- if (fp == NULL) +- cannot_create(fn); +- } else if (if_exists == sKoverwrite) { +- fp = fopen_not_dir(FN1, "r+"); +- if (fp == NULL) +- cannot_open(fn); +- } else if (if_exists == sKappend) { +- if (smm == smm_output) +- fp = fopen_not_dir(FN1, "a"); +- else +- fp = fopen_not_dir(FN1, "a+"); +- if (fp == NULL) ++ if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); ++ } else if (if_exists==sKrename_and_delete || ++ if_exists==sKnew_version || ++ if_exists==sKsupersede) { ++ if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); ++ } else if (if_exists==sKoverwrite) { ++ if (!(fp=fopen_not_dir(FN1,"r+"))) cannot_open(fn); ++ } else if (if_exists==sKappend) { ++ if (!(fp = fopen_not_dir(FN1,smm==smm_output ? "a" : "a+"))) + FEerror("Cannot append to the file ~A.",1,fn); +- } else if (if_exists == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-EXISTS option.", +- 1, if_exists); ++ } else if (if_exists == Cnil) return(Cnil); ++ else FEerror("~S is an illegal IF-EXISTS option.",1,if_exists); ++ + } else { ++ + if (if_does_not_exist == sKerror) + FILE_ERROR(fn,"The file does not exist"); + else if (if_does_not_exist == sKcreate) { +- if (smm == smm_output) { +- if(FN1[0]=='|') +- fp = popen(FN1+1,"w"); +- else +- fp = fopen_not_dir(FN1, "w"); +- } else +- fp = fopen_not_dir(FN1, "w+"); +- if (fp == NULL) ++ if (!(fp=smm==smm_output ? (*FN1=='|' ? popen(FN1+1,"w") : fopen_not_dir(FN1, "w")) : fopen_not_dir(FN1, "w+"))) + cannot_create(fn); +- } else if (if_does_not_exist == Cnil) +- return(Cnil); +- else +- FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", +- 1, if_does_not_exist); ++ } else if (if_does_not_exist==Cnil) return(Cnil); ++ else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist); + } +- } else ++ break; ++ ++ default: + FEerror("Illegal open mode for ~S.",1,fn); ++ break; ++ } + + vs_push(make_simple_string(FN1)); + x = alloc_object(t_stream); +@@ -600,10 +566,6 @@ close_stream(object strm) { + fclose(strm->sm.sm_fp); + strm->sm.sm_fp = NULL; + strm->sm.sm_fd = -1; +- if (strm->sm.sm_object0 && +- type_of(strm->sm.sm_object0 )==t_cons && +- Mcar(strm->sm.sm_object0)==sSAallow_gzipped_fileA) +- ifuncall1(sLdelete_file,Mcdr(strm->sm.sm_object0)); + break; + + case smm_file_synonym: +@@ -1762,9 +1724,7 @@ LFD(siLoutput_stream_string)() + } + + DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- RETURN1(type_of(x)==t_stream && +- (x->sm.sm_mode==smm_input || x->sm.sm_mode==smm_output || x->sm.sm_mode==smm_io || x->sm.sm_mode==smm_probe) +- ? Ct : Cnil); ++ RETURN1(type_of(x)==t_stream && file_synonym_stream_p(x) ? Ct : Cnil); + } + + DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -19,8 +19,6 @@ Foundation, 675 Mass Ave, Cambridge, MA + + */ + +-#include +-#include + #include + #include + +@@ -32,140 +30,17 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include + #endif + +-#ifdef __MINGW32__ +-# include ++#ifdef __MINGW32__ ++# include + /* Windows has no symlink, therefore no lstat. Without symlinks lstat + is equivalent to stat anyway. */ + # define S_ISLNK(a) 0 + # define lstat stat +-#endif +- +-#ifdef BSD +-#define HAVE_RENAME + #endif + +-#ifdef NEED_GETWD +-#include +- +- +-#ifndef HAVE_GETCWD +-char dotdot[3*16+2] = "../../../../../../../../../../../../../../../../."; +-#include +-static char *getwd_buf; +-static int getwd_bufp; +- +-static char * +-getwd(buffer) +-char *buffer; +-{ +- getwd_buf = buffer; +- getwd1(0); +- if (getwd_bufp == 0) +- getwd_buf[getwd_bufp++] = '/'; +- getwd_buf[getwd_bufp] = '\0'; +- return(getwd_buf); +-} +- +-getwd1(n) +-int n; +-{ +- struct stat st, dev_st; +- struct direct dir; +- ino_t ino; +- struct mnttab mnt; +- FILE *fp; +- register int i; +- char buf[BUFSIZ]; +- static char dev_name[64]; +- +- if (stat(dotdot+(16-n)*3, &st) < 0) +- FEerror("Can't get the current working directory.", 0); +- ino = st.st_ino; +- if (ino == 2) +- goto ROOT; +- getwd1(n+1); +- fp = fopen(dotdot+(16-n-1)*3, "r"); +- if (fp == NULL) +- FEerror("Can't get the current working directory.", 0); +- setbuf(fp, buf); +- fread(&dir, sizeof(struct direct), 1, fp); +- fread(&dir, sizeof(struct direct), 1, fp); +- for (;;) { +- if (fread(&dir, sizeof(struct direct), 1, fp) <= 0) +- break; +- if (dir.d_ino == ino) +- goto FOUND; +- } +- fclose(fp); +- FEerror("Can't get the current working directory.", 0); +- +-FOUND: +- fclose(fp); +- getwd_buf[getwd_bufp++] = '/'; +- for (i = 0; i < DIRSIZ && dir.d_name[i] != '\0'; i++) +- getwd_buf[getwd_bufp++] = dir.d_name[i]; +- return; +- +-ROOT: +- fp = fopen("/etc/mnttab", "r"); +- if (fp == NULL) +- FEerror("Can't get the current working directory.", 0); +- setbuf(fp, buf); +- for (;;) { +- if (fread(&mnt, sizeof(struct mnttab), 1, fp) <= 0) +- break; +- if (mnt.mt_dev[0] != '/') { +- strcpy(dev_name, "/dev/dsk/"); +- strcat(dev_name, mnt.mt_dev); +- stat(dev_name, &dev_st); +- } else +- stat(mnt.mt_dev, &dev_st); +- if (dev_st.st_rdev == st.st_dev) +- goto DEV_FOUND; +- } +- fclose(fp); +- getwd_bufp = 0; +- return; +- +-DEV_FOUND: +- fclose(fp); +- getwd_bufp = 0; +- for (i = 0; mnt.mt_filsys[i] != '\0'; i++) +- getwd_buf[i] = mnt.mt_filsys[i]; +- /* BUG FIX by Grant J. Munsey */ +- if (i == 1 && *getwd_buf == '/') +- i = 0; /* don't add an empty directory name */ +- /* END OF BUG FIX */ +- getwd_bufp = i; +-} +-#endif /* not HAVE_GETCWD */ +-#endif +- +-#ifndef MAXPATHLEN +-#define MAXPATHLEN 512 +-#endif +- +- +-#ifdef HAVE_GETCWD +-char * +-getwd(char *buffer) { +-#ifndef _WIN32 +- char *getcwd(char *, size_t); +-#endif +- return(getcwd(buffer, MAXPATHLEN)); +-} +-#endif +- +- +-#define pcopy(a_,b_,c_,d_) ({\ +- unsigned _c=c_,_d=d_;\ +- if (_c+_d>=MAXPATHLEN-16) FEerror("Can't expand pathname ~a",1,namestring);\ +- bcopy(a_,b_+_c,_d);\ +- b_[_c+_d]=0;\ +- }) +- + static object + get_string(object x) { ++ + switch(type_of(x)) { + case t_symbol: + case t_string: +@@ -180,182 +55,110 @@ get_string(object x) { + case smm_io: + return get_string(x->sm.sm_object1); + case smm_file_synonym: +- case smm_synonym: + return get_string(x->sm.sm_object0->s.s_dbind); + } + } ++ + return Cnil; +-} + ++} + + void +-coerce_to_filename(object pathname,char *p) { ++coerce_to_filename1(object spec, char *p,unsigned sz) { + +- object namestring=get_string(pathname); +- unsigned e=namestring->st.st_fillp; +- char *q=namestring->st.st_self,*qe=q+e; ++ object namestring=get_string(spec); + +- if (pathname==Cnil||namestring==Cnil) +- FEerror ( "NIL argument.", 1, pathname ); +- +- if (*q=='~' && e) { ++ massert(namestring->st.st_fillpst.st_self,namestring->st.st_fillp); ++ p[namestring->st.st_fillp]=0; + +- unsigned m=0; +- char *s=++q,*c; ++#ifdef FIX_FILENAME ++ FIX_FILENAME(spec,p); ++#endif + +- for (;spw_dir,p,0,m=strlen(pwent->pw_dir)); +- +- } +-#endif ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++ massert(rpw_name)); + +- pcopy(q,p,0,e); +- +-#ifdef FIX_FILENAME +- FIX_FILENAME(pathname,p); +-#endif +- + } + +-object sSAallow_gzipped_fileA; ++DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { + +-bool +-file_exists(object file) +-{ +- char filename[MAXPATHLEN]; +- struct stat filestatus; ++ struct passwd *pwent,pw; ++ long r; + +- coerce_to_filename(file, filename); ++ massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); ++ massert(r filename) && +- ( ( *(p-1) == '/' ) || ( *(p-1) == '\\' ) ) ) { +- *(p-1) = '\0'; +- } +- } +-#endif +- +- if (stat(filename, &filestatus) >= 0 && !S_ISDIR(filestatus.st_mode)) +- { +-#ifdef AIX +- /* if /tmp/foo is not a directory /tmp/foo/ should not exist */ +- if (filename[strlen(filename)-1] == '/' && +- !( filestatus.st_mode & S_IFDIR)) +- return(FALSE); +-#endif +- +- return TRUE; +- } +- else +- if (sSAallow_gzipped_fileA->s.s_dbind != sLnil +- && (strcat(filename,".gz"), +- stat(filename, &filestatus) >= 0 && !S_ISDIR(filestatus.st_mode))) +- +- return TRUE; ++ if (nm->st.st_fillp==1) + +- else +- return(FALSE); +-} ++ if ((pw.pw_dir=getenv("HOME"))) ++ pwent=&pw; ++ else ++ massert(!getpwuid_r(getuid(),&pw,FN1,r,&pwent) && pwent); + +-FILE * +-fopen_not_dir(char *filename,char * option) { ++ else { + +- struct stat ss; ++ massert(nm->st.st_fillpst.st_self+1,nm->st.st_fillp-1); ++ FN2[nm->st.st_fillp-1]=0; + +- if (!stat(filename,&ss) && S_ISDIR(ss.st_mode)) +- return NULL; +- else +- return fopen(filename,option); ++ massert(!getpwnam_r(FN2,&pw,FN1,r,&pwent) && pwent); ++ ++ } ++ ++ massert(strlen(pwent->pw_dir)+2pw_dir,strlen(pwent->pw_dir)); ++ FN3[strlen(pwent->pw_dir)]='/'; ++ FN3[strlen(pwent->pw_dir)+1]=0; ++ RETURN1(make_simple_string(FN3)); + + } + ++#define FILE_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISREG(b_.st_mode) ++#define DIR_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISDIR(b_.st_mode) ++ + FILE * +-backup_fopen(char *filename, char *option) +-{ +- char backupfilename[MAXPATHLEN]; +- char command[MAXPATHLEN * 2]; ++fopen_not_dir(char *filename,char *option) { ++ ++ struct stat ss; ++ ++ return DIR_EXISTS_P(filename,ss) ? NULL : fopen(filename,option); + +- strcat(strcpy(backupfilename, filename), ".BAK"); +- sprintf(command, "mv %s %s", filename, backupfilename); +- msystem(command); +- return(fopen(filename, option)); + } + + int +-file_len(FILE *fp) +-{ +- struct stat filestatus; ++file_len(FILE *fp) {/*FIXME dir*/ + +- if (fstat(fileno(fp), &filestatus)==0) +- return(filestatus.st_size); +- else return 0; +-} ++ struct stat filestatus; + +-DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); +-DEF_ORDINARY("LINK",sKlink,KEYWORD,""); +-DEF_ORDINARY("FILE",sKfile,KEYWORD,""); ++ return fstat(fileno(fp), &filestatus) ? 0 : filestatus.st_size; + +-/* export these for AXIOM */ +-int gcl_putenv(char *s) {return putenv(s);} +-char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);} +-char *gcl_strncpy_chk(size_t z) {char a[10],b[10];return strncpy(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/ +-#ifdef __MINGW32__ +-#define uid_t int +-#endif +-uid_t gcl_geteuid(void) { +-#ifndef __MINGW32__ +- return geteuid(); +-#else +- return 0; +-#endif +-} +-uid_t gcl_getegid(void) { +-#ifndef __MINGW32__ +- return getegid(); +-#else +- return 0; +-#endif + } +-int gcl_dup2(int o,int n) {return dup2(o,n);} +-char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);} +-int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;} + ++bool ++file_exists(object x) { + +-int gcl_feof(void *v) {return feof(((FILE *)v));} +-int gcl_getc(void *v) {return getc(((FILE *)v));} +-int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));} ++ struct stat ss; ++ ++ coerce_to_filename(x,FN1); + ++ return FILE_EXISTS_P(FN1,ss) ? TRUE : FALSE; + ++} ++ ++DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); ++DEF_ORDINARY("LINK",sKlink,KEYWORD,""); ++DEF_ORDINARY("FILE",sKfile,KEYWORD,""); + + DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + +@@ -381,6 +184,31 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N + make_fixnum(ss.st_uid)); + } + ++#include ++#include ++#include ++#include ++ ++DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { ++ ssize_t l,z1; ++ ++ check_type_string(&s); ++ /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ ++ z1=length(s); ++ massert(z1st.st_self,z1); ++ FN1[z1]=0; ++ massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && l + + DEFUN_NEW("OPENDIR",object,fSopendir,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { +- DIR *d; +- char filename[MAXPATHLEN]; + check_type_string(&x); +- memcpy(filename,x->st.st_self,x->st.st_fillp); +- filename[x->st.st_fillp]=0; +- d=opendir(filename); +- return (object)d; ++ coerce_to_filename(x,FN1); ++ return (object)opendir(FN1); + } + + #ifdef HAVE_D_TYPE +@@ -430,19 +254,27 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_ + MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN")) + )); + } ++#else ++#define DT_UNKNOWN 0 + #endif + + DEFUN_NEW("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,object s),"") { ++ + struct dirent *e; + object z; + long tl; + size_t l; ++ + if (!x) RETURN1(Cnil); ++ + tl=telldir((DIR *)x); +-#ifdef HAVE_D_TYPE +- for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); ++ ++#ifndef HAVE_D_TYPE ++ y=DT_UNKNOWN; + #endif ++ for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); + if (!e) RETURN1(Cnil); ++ + if (s==Cnil) + z=make_simple_string(e->d_name); + else { +@@ -457,10 +289,13 @@ DEFUN_NEW("READDIR",object,fSreaddir,SI, + RETURN1(make_fixnum(l)); + } + } ++ + #ifdef HAVE_D_TYPE + if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type)); + #endif ++ + RETURN1(z); ++ + } + + DEFUN_NEW("CLOSEDIR",object,fSclosedir,SI,1,1,NONE,OI,OO,OO,OO,(fixnum x),"") { +@@ -468,165 +303,174 @@ DEFUN_NEW("CLOSEDIR",object,fSclosedir,S + return Cnil; + } + +-DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- +- char filename[MAXPATHLEN]; ++DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { + + check_type_string(&x); ++ check_type_string(&y); + +- memcpy(filename,x->st.st_self,x->st.st_fillp); +- filename[x->st.st_fillp]=0; +- +-#ifdef __MINGW32__ +- if (mkdir(filename) < 0) +-#else +- if (mkdir(filename,01777) < 0) +-#endif +- FEerror("Cannot make the directory ~S.", 1, vs_base[0]); ++ coerce_to_filename(x,FN1); ++ coerce_to_filename(y,FN2); + +- RETURN1(x); ++ RETURN1(rename(FN1,FN2) ? Cnil : Ct); + + } + +-DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ + check_type_string(&x); + + coerce_to_filename(x,FN1); + +- RETURN1(rmdir(FN1) ? Cnil : Ct); ++ RETURN1(unlink(FN1) ? Cnil : Ct); + + } + + ++DEFUN_NEW("CHDIR1",object,fSchdir1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + +-#include +-#include +-#include +-#include ++ check_type_string(&x); + +-DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { +- char *b1,*b2=NULL; +- ssize_t l,z1,z2; +- check_type_string(&s); +- /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ +- z1=length(s); +- massert((b1=alloca(z1+1))); +- memcpy(b1,s->st.st_self,z1); +- b1[z1]=0; +- for (l=z2=0;l>=z2;) { +- memset(b2,0,z2); +- z2+=z2+10; +- massert((b2=alloca(z2))); +- massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,b1,b2,z2))>=0); +- } +- b2[l]=0; +- s=make_simple_string(b2); +- memset(b1,0,z1); +- memset(b2,0,z2); +- RETURN1(s); +-} ++ coerce_to_filename(x,FN1); + +-DEFUN_NEW("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { +- char *b=NULL; +- size_t z; +- object s; +- +- for (z=0;!(errno=0) && !getcwd(b,z) && errno==ERANGE;b=memset(b,0,z),z+=z+10,({massert((b=alloca(z)));})); +- massert((b=getcwd(b,z))); +- s=make_simple_string(b); +- memset(b,0,z); +- RETURN1(s); ++ RETURN1(chdir(FN1) ? Cnil : Ct); + + } + +-DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { +- struct passwd *pwent,pw; +- char *b; +- long r; ++DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + +- massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +- massert(b=alloca(r)); ++ check_type_string(&x); + +- massert(!getpwuid_r(uid,&pw,b,r,&pwent)); ++ coerce_to_filename(x,FN1); + +- RETURN1(make_simple_string(pwent->pw_name)); ++ RETURN1(mkdir(FN1 ++#ifndef __MINGW32__ ++ ,01777 ++#endif ++ ) ? Cnil : Ct); + + } + +-DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { ++DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { ++ check_type_string(&x); + +- struct passwd *pwent,pw; +- char *b; +- long r; ++ coerce_to_filename(x,FN1); + +- massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +- massert(b=alloca(r)); ++ RETURN1(rmdir(FN1) ? Cnil : Ct); + +- if (nm->st.st_fillp==1) ++} + +- if ((pw.pw_dir=getenv("HOME"))) +- pwent=&pw; +- else +- massert(!getpwuid_r(getuid(),&pw,b,r,&pwent)); ++DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,""); + +- else { ++#ifdef _WIN32 + +- char *name; ++void * ++get_mmap(FILE *fp,void **ve) { + +- massert(name=alloca(nm->st.st_fillp)); +- memcpy(name,nm->st.st_self+1,nm->st.st_fillp-1); +- name[nm->st.st_fillp-1]=0; ++ int n; ++ void *st; ++ size_t sz; ++ HANDLE handle; ++ ++ massert((sz=file_len(fp))>0); ++ if (sSAload_with_freadA->s.s_dbind==Cnil) { ++ n=fileno(fp); ++ massert((n=fileno(fp))>2); ++ massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL)); ++ massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz)); ++ CloseHandle(handle); ++ } else { ++ massert(st=malloc(sz)); ++ massert(fread(st,sz,1,fp)==1); ++ } + +- massert(!getpwnam_r(name,&pw,b,r,&pwent)); ++ *ve=st+sz; + +- } ++ return st; ++ ++} + +- massert((b=alloca(strlen(pwent->pw_dir)+2))); +- memcpy(b,pwent->pw_dir,strlen(pwent->pw_dir)); +- b[strlen(pwent->pw_dir)]='/'; +- b[strlen(pwent->pw_dir)+1]=0; +- RETURN1(make_simple_string(b)); ++int ++un_mmap(void *v1,void *ve) { ++ ++ if (sSAload_with_freadA->s.s_dbind==Cnil) ++ return UnmapViewOfFile(v1) ? 0 : -1; ++ else { ++ free(v1); ++ return 0; ++ } + + } + +-DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { + +- check_type_string(&x); +- check_type_string(&y); ++#else + +- coerce_to_filename(x,FN1); +- coerce_to_filename(y,FN2); ++#include + +- RETURN1(rename(FN1,FN2) ? Cnil : Ct); ++void * ++get_mmap(FILE *fp,void **ve) { ++ ++ int n; ++ void *v1; ++ struct stat ss; ++ ++ massert((n=fileno(fp))>2); ++ massert(!fstat(n,&ss)); ++ if (sSAload_with_freadA->s.s_dbind==Cnil) { ++ massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1); ++ } else { ++ massert(v1=malloc(ss.st_size)); ++ massert(fread(v1,ss.st_size,1,fp)==1); ++ } ++ ++ *ve=v1+ss.st_size; ++ return v1; + + } + +-DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + +- coerce_to_filename(x,FN1); ++int ++un_mmap(void *v1,void *ve) { + +- RETURN1(unlink(FN1) ? Cnil : Ct); ++ if (sSAload_with_freadA->s.s_dbind==Cnil) ++ return munmap(v1,ve-v1); ++ else { ++ free(v1); ++ return 0; ++ } + + } + ++#endif + +-static void +-FFN(siLchdir)(void) +-{ +- char filename[MAXPATHLEN]; +- +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- coerce_to_filename(vs_base[0], filename); +- +- if (chdir(filename) < 0) +- FEerror("Can't change the current directory to ~S.", +- 1, vs_base[0]); ++/* export these for AXIOM */ ++int gcl_putenv(char *s) {return putenv(s);} ++char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);} ++char *gcl_strncpy_chk(size_t z) {char a[10],b[10];return strncpy(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/ ++#ifdef __MINGW32__ ++#define uid_t int ++#endif ++uid_t gcl_geteuid(void) { ++#ifndef __MINGW32__ ++ return geteuid(); ++#else ++ return 0; ++#endif ++} ++uid_t gcl_getegid(void) { ++#ifndef __MINGW32__ ++ return getegid(); ++#else ++ return 0; ++#endif + } ++int gcl_dup2(int o,int n) {return dup2(o,n);} ++char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);} ++int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;} ++ ++int gcl_feof(void *v) {return feof(((FILE *)v));} ++int gcl_getc(void *v) {return getc(((FILE *)v));} ++int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));} + + void + gcl_init_unixfsys(void) { +- +- make_si_function("CHDIR", siLchdir); +- + } +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -235,89 +235,6 @@ DEFUN_NEW("GETPID",object,fSgetpid,SI,0, + } + + +-DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,""); +- +-#ifdef _WIN32 +- +-void * +-get_mmap(FILE *fp,void **ve) { +- +- int n; +- void *st; +- size_t sz; +- HANDLE handle; +- +- massert((sz=file_len(fp))>0); +- if (sSAload_with_freadA->s.s_dbind==Cnil) { +- n=fileno(fp); +- massert((n=fileno(fp))>2); +- massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL)); +- massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz)); +- CloseHandle(handle); +- } else { +- massert(st=malloc(sz)); +- massert(fread(st,sz,1,fp)==1); +- } +- +- *ve=st+sz; +- +- return st; +- +-} +- +-int +-un_mmap(void *v1,void *ve) { +- +- if (sSAload_with_freadA->s.s_dbind==Cnil) +- return UnmapViewOfFile(v1) ? 0 : -1; +- else { +- free(v1); +- return 0; +- } +- +-} +- +- +-#else +- +-#include +- +-void * +-get_mmap(FILE *fp,void **ve) { +- +- int n; +- void *v1; +- struct stat ss; +- +- massert((n=fileno(fp))>2); +- massert(!fstat(n,&ss)); +- if (sSAload_with_freadA->s.s_dbind==Cnil) { +- massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1); +- } else { +- massert(v1=malloc(ss.st_size)); +- massert(fread(v1,ss.st_size,1,fp)==1); +- } +- +- *ve=v1+ss.st_size; +- return v1; +- +-} +- +- +-int +-un_mmap(void *v1,void *ve) { +- +- if (sSAload_with_freadA->s.s_dbind==Cnil) +- return munmap(v1,ve-v1); +- else { +- free(v1); +- return 0; +- } +- +-} +- +-#endif +- + void + gcl_init_unixsys(void) { + diff --git a/patches/pathnames1.3 b/patches/pathnames1.3 new file mode 100644 index 00000000..311c6277 --- /dev/null +++ b/patches/pathnames1.3 @@ -0,0 +1,48 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-40) unstable; urgency=medium + . + * pathnames1.2 + * Bug fix: "popen arguments not quoted causes trouble and security + issues", thanks to axel (Closes: #802203). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/802203 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-14 + +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -83,7 +83,7 @@ DEFUN_NEW("UID-TO-NAME",object,fSuid_to_ + long r; + + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +- massert(r=0); +- massert(rst.st_fillp==1) + diff --git a/patches/pathnames1.4 b/patches/pathnames1.4 new file mode 100644 index 00000000..e52d8916 --- /dev/null +++ b/patches/pathnames1.4 @@ -0,0 +1,36 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-41) unstable; urgency=medium + . + * pathnames1.3, kfreebsd fix +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-14 + +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -180,7 +180,7 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N + RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : + (S_ISLNK(ss.st_mode) ? sKlink : sKfile), + make_fixnum(ss.st_size), +- make_fixnum(ss.st_ctime), ++ make_fixnum(ss.st_mtime), + make_fixnum(ss.st_uid)); + } + diff --git a/patches/pathnames1.5 b/patches/pathnames1.5 new file mode 100644 index 00000000..66b8ac0d --- /dev/null +++ b/patches/pathnames1.5 @@ -0,0 +1,10494 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-41) unstable; urgency=medium + . + * pathnames1.4, kfreebsd fix +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-26 + +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -488,20 +488,6 @@ Cannot compile ~a.~%" + (t (setq dir "."))) + (setq na (namestring + (make-pathname :name name :type (pathname-type(first args))))) +- #+(or dos winnt) +- (format nil "~a -I~a ~a ~a -c -w ~a -o ~a" +- *cc* +- (concatenate 'string si::*system-directory* "../h") +- (if (and (boundp '*c-debug*) *c-debug*) " -g " "") +- (case *speed* +- (3 *opt-three* ) +- (2 *opt-two*) +- (t "")) +- (namestring (make-pathname :type "c" :defaults (first args))) +- (namestring (make-pathname :type "o" :defaults (first args))) +- ) +- +- #-(or dos winnt) + (format nil "~a -I~a ~a ~a -c ~a -o ~a ~a" + *cc* + (concatenate 'string si::*system-directory* "../h") +@@ -527,8 +513,8 @@ Cannot compile ~a.~%" + #+expect-unresolved "-expect_unresolved '*'" + na na na)) + +- #+bsd ""; "-w" +- #-(or aix3 bsd irix3) " 2> /dev/null ") ++ #+(or winnt bsd) ""; "-w" ++ #-(or aix3 bsd winnt irix3) " 2> /dev/null ") + + + ) +@@ -543,30 +529,14 @@ Cannot compile ~a.~%" + (prep-win-path-acc finish (concatenate 'string acc start "~"))) + (concatenate 'string acc s)))) + +-#+winnt +-(defun no-device (c) +- (let* ((c (namestring (truename c))) +- (p (search ":" c))) +- (if p (subseq c (1+ p)) c))) +- +-;; #+winnt +-;; (defun prep-win-path (c o) +-;; (let* ((w si::*wine-detected*) +-;; (c (if w (no-device c) c)) +-;; (o (if w (no-device o) o))) +-;; (prep-win-path-acc (compiler-command c o) ""))) +- + (defun compiler-cc (c-pathname o-pathname) + (safe-system + (format + nil +- (prog1 +- #+irix5 (compiler-command c-pathname o-pathname ) +- #+vax "~a ~@[~*-O ~]-S -I. -w ~a ; as -J -W -o ~A ~A" +- #+(or system-v e15 dgux sgi ) "~a ~@[~*-O ~]-c -I. ~a 2> /dev/null" +- #+winnt (prep-win-path-acc (compiler-command c-pathname o-pathname) "") +- #-winnt (compiler-command c-pathname o-pathname) +- ) ++ #+vax "~a ~@[~*-O ~]-S -I. -w ~a ; as -J -W -o ~A ~A" ++ #+(or system-v e15 dgux sgi ) "~a ~@[~*-O ~]-c -I. ~a 2> /dev/null" ++ #+winnt (prep-win-path-acc (compiler-command c-pathname o-pathname) "") ++ #-(or vax system-v e15 dgux sgi) (compiler-command c-pathname o-pathname) + *cc* + (if (or (= *speed* 2) (= *speed* 3)) t nil) + (namestring c-pathname) +@@ -763,20 +733,9 @@ Cannot compile ~a.~%" + `(let ((,q (si::string-match ,x ,y ,@(when z (list z))))) + (if (= ,q -1) (length ,y) ,q))))) + +-(defun ts (s &optional (r "")) +- (declare (string s) (ignorable r)) +- #+winnt +- (if (not si::*wine-detected*) s +- (let* ((x (sml (fcr #u"[^ \n\t]") s)) +- (y (sml (fcr #u"[ \n\t]") s x)) +- (f (subseq s x y)) +- (l (subseq s y)) +- (k (when (> (length f) 0) (aref f 0))) +- (q (if (eql k #\") (string k) "")) +- (f (if (eql k #\") (subseq f 1 (1- (length f))) f)) +- (f (if (and k (not (eql k #\-))) (namestring (no-device f)) f))) +- (if k (concatenate 'string r q f q (ts l " ")) ""))) +- #-winnt s) ++(defun ts (s) ++ (declare (string s)) ++ s) + + (defun mdelete-file (x) + (delete-file (ts (namestring x)))) +@@ -795,8 +754,7 @@ Cannot compile ~a.~%" + raw)) + (map (merge-pathnames (make-pathname + :name (concatenate 'string (pathname-name raw) "_map")) raw)) +- #+winnt (raw (merge-pathnames (make-pathname :type "exe") raw)) +- ) ++ #+winnt (raw (merge-pathnames (make-pathname :type "exe") raw))) + + (with-open-file (st (namestring map) :direction :output)) + (safe-system +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -624,7 +624,6 @@ use + GNU_LD + LEADING_UNDERSCORE + EXTRA_LOBJS +-PRELINK_CHECK + O2FLAGS + O3FLAGS + NIFLAGS +@@ -678,6 +677,7 @@ EGREP + GREP + MAKEINFO + AWK ++GCL_CC + CPP + OBJEXT + EXEEXT +@@ -686,7 +686,7 @@ CPPFLAGS + LDFLAGS + CFLAGS + CC +-PROCESSOR_FLAGS ++PRELINK_CHECK + host_os + host_vendor + host_cpu +@@ -738,41 +738,38 @@ SHELL' + ac_subst_files='' + ac_user_opts=' + enable_option_checking ++enable_machine + enable_widecons + enable_safecdr + enable_safecdrdbg + enable_prelink +-enable_fastimmfix +-enable_holepage + enable_vssize + enable_bdssize + enable_ihssize + enable_frssize +-enable_machine +-enable_immfix +-enable_notify +-enable_tcltk +-enable_tkconfig +-enable_tclconfig + enable_infodir + enable_emacsdir +-enable_common_binary +-enable_japi +-enable_xdr + enable_xgcl + enable_dlopen + enable_statsysbfd + enable_dynsysbfd + enable_custreloc + enable_debug +-enable_gprof + enable_static + enable_pic +-enable_oldgmp ++enable_gprof + enable_dynsysgmp + with_x +-enable_readline ++enable_xdr ++enable_immfix ++enable_fastimmfix + enable_ansi ++enable_japi ++enable_readline ++enable_tcltk ++enable_tkconfig ++enable_tclconfig ++enable_notify + ' + ac_precious_vars='build_alias + host_alias +@@ -1410,51 +1407,37 @@ Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] +-use a three word cons with simplified typing +-protect cdr from immfix and speed up type processing +-debug safecdr code +---enable-prelink will insist that the produced images may be prelinked +---enable-fastimmfix=XXXX will reject low immediate fixnums unless 1<&6; } + + } # ac_fn_c_check_member + ++# ac_fn_c_try_link LINENO ++# ----------------------- ++# Try to link conftest.$ac_ext, and return whether this succeeded. ++ac_fn_c_try_link () ++{ ++ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack ++ rm -f conftest.$ac_objext conftest$ac_exeext ++ if { { ac_try="$ac_link" ++case "(($ac_try" in ++ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; ++ *) ac_try_echo=$ac_try;; ++esac ++eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" ++$as_echo "$ac_try_echo"; } >&5 ++ (eval "$ac_link") 2>conftest.err ++ ac_status=$? ++ if test -s conftest.err; then ++ grep -v '^ *+' conftest.err >conftest.er1 ++ cat conftest.er1 >&5 ++ mv -f conftest.er1 conftest.err ++ fi ++ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 ++ test $ac_status = 0; } && { ++ test -z "$ac_c_werror_flag" || ++ test ! -s conftest.err ++ } && test -s conftest$ac_exeext && { ++ test "$cross_compiling" = yes || ++ test -x conftest$ac_exeext ++ }; then : ++ ac_retval=0 ++else ++ $as_echo "$as_me: failed program was:" >&5 ++sed 's/^/| /' conftest.$ac_ext >&5 ++ ++ ac_retval=1 ++fi ++ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information ++ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would ++ # interfere with the next link command; also delete a directory that is ++ # left behind by Apple's compiler. We do this before executing the actions. ++ rm -rf conftest.dSYM conftest_ipa8_conftest.oo ++ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno ++ as_fn_set_status $ac_retval ++ ++} # ac_fn_c_try_link ++ + # ac_fn_c_check_func LINENO FUNC VAR + # ---------------------------------- + # Tests whether FUNC exists, setting the cache variable VAR accordingly +@@ -2506,226 +2535,6 @@ ac_config_headers="$ac_config_headers h/ + VERSION=`cat majvers`.`cat minvers` + + +-# some parts of this configure script are taken from the tcl configure.in +- +-# +-# Arguments +-# +- +- +- +- +-# Check whether --enable-widecons was given. +-if test "${enable_widecons+set}" = set; then : +- enableval=$enable_widecons; +-$as_echo "#define WIDE_CONS 1" >>confdefs.h +- +-fi +- +- +- +-# Check whether --enable-safecdr was given. +-if test "${enable_safecdr+set}" = set; then : +- enableval=$enable_safecdr; +-else +- enable_safecdr="no" +-fi +- +-if test "$enable_safecdr" = "yes" ; then +- +-$as_echo "#define USE_SAFE_CDR 1" >>confdefs.h +- +-fi +-# Check whether --enable-safecdrdbg was given. +-if test "${enable_safecdrdbg+set}" = set; then : +- enableval=$enable_safecdrdbg; +-$as_echo "#define DEBUG_SAFE_CDR 1" >>confdefs.h +- +-fi +- +- +-# Check whether --enable-prelink was given. +-if test "${enable_prelink+set}" = set; then : +- enableval=$enable_prelink; PRELINK_CHECK=t +-else +- PRELINK_CHECK= +-fi +- +- +-# Check whether --enable-fastimmfix was given. +-if test "${enable_fastimmfix+set}" = set; then : +- enableval=$enable_fastimmfix; +-else +- enable_fastimmfix=64 +-fi +- +- +- +-# Check whether --enable-holepage was given. +-if test "${enable_holepage+set}" = set; then : +- enableval=$enable_holepage; +-cat >>confdefs.h <<_ACEOF +-#define HOLEPAGE $enable_holepage +-_ACEOF +- +-fi +- +- +-# Check whether --enable-vssize was given. +-if test "${enable_vssize+set}" = set; then : +- enableval=$enable_vssize; +-else +- enable_vssize=262144 +-fi +- +- +-cat >>confdefs.h <<_ACEOF +-#define VSSIZE $enable_vssize +-_ACEOF +- +- +-# Check whether --enable-bdssize was given. +-if test "${enable_bdssize+set}" = set; then : +- enableval=$enable_bdssize; +-else +- enable_bdssize=2048 +-fi +- +- +-cat >>confdefs.h <<_ACEOF +-#define BDSSIZE $enable_bdssize +-_ACEOF +- +- +-# Check whether --enable-ihssize was given. +-if test "${enable_ihssize+set}" = set; then : +- enableval=$enable_ihssize; +-else +- enable_ihssize=4096 +-fi +- +- +-cat >>confdefs.h <<_ACEOF +-#define IHSSIZE $enable_ihssize +-_ACEOF +- +- +-# Check whether --enable-frssize was given. +-if test "${enable_frssize+set}" = set; then : +- enableval=$enable_frssize; +-else +- enable_frssize=4096 +-fi +- +- +-cat >>confdefs.h <<_ACEOF +-#define FRSSIZE $enable_frssize +-_ACEOF +- +- +-# Check whether --enable-machine was given. +-if test "${enable_machine+set}" = set; then : +- enableval=$enable_machine; enable_machine=$enableval +-else +- enable_machine="" +-fi +- +- +-# Check whether --enable-immfix was given. +-if test "${enable_immfix+set}" = set; then : +- enableval=$enable_immfix; +-else +- enable_immfix=yes +-fi +- +- +-#AC_ARG_ENABLE(gmp,[ --enable-gmp=no will disable use of GMP gnu multiprecision arithmetic, (default is =yes)] , +-#[use_gmp=$enableval],[use_gmp="yes"]) +- +-use_gmp="yes" +- +-# Check whether --enable-notify was given. +-if test "${enable_notify+set}" = set; then : +- enableval=$enable_notify; enable_notify=$enableval +-else +- enable_notify="yes" +-fi +- +- +-# Check whether --enable-tcltk was given. +-if test "${enable_tcltk+set}" = set; then : +- enableval=$enable_tcltk; enable_tcltk=$enableval +-else +- enable_tcltk="yes" +-fi +- +- +-# Check whether --enable-tkconfig was given. +-if test "${enable_tkconfig+set}" = set; then : +- enableval=$enable_tkconfig; TK_CONFIG_PREFIX=$enableval +-else +- TK_CONFIG_PREFIX="unknown" +-fi +- +- +- +-# Check whether --enable-tclconfig was given. +-if test "${enable_tclconfig+set}" = set; then : +- enableval=$enable_tclconfig; TCL_CONFIG_PREFIX=$enableval +-else +- TCL_CONFIG_PREFIX="unknown" +-fi +- +- +-# Check whether --enable-infodir was given. +-if test "${enable_infodir+set}" = set; then : +- enableval=$enable_infodir; INFO_DIR=$enableval +-else +- INFO_DIR=$prefix/share/info +-fi +- +-INFO_DIR=`eval echo $INFO_DIR/` +- +-# Check whether --enable-emacsdir was given. +-if test "${enable_emacsdir+set}" = set; then : +- enableval=$enable_emacsdir; EMACS_SITE_LISP=$enableval +-else +- EMACS_SITE_LISP=$prefix/share/emacs/site-lisp +-fi +- +-EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` +- +-# Check whether --enable-common-binary was given. +-if test "${enable_common_binary+set}" = set; then : +- enableval=$enable_common_binary; use_common_binary=$enableval +-else +- use_common_binary="yes" +-fi +- +- +-# Check whether --enable-japi was given. +-if test "${enable_japi+set}" = set; then : +- enableval=$enable_japi; try_japi=$enableval +-else +- try_japi="no" +-fi +- +- +-# Check whether --enable-xdr was given. +-if test "${enable_xdr+set}" = set; then : +- enableval=$enable_xdr; enable_xdr=$enableval +-else +- enable_xdr="yes" +-fi +- +- +-# Check whether --enable-xgcl was given. +-if test "${enable_xgcl+set}" = set; then : +- enableval=$enable_xgcl; enable_xgcl=$enableval +-else +- enable_xgcl="yes" +-fi +- + + # + # Host information +@@ -2856,380 +2665,247 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: host=$host" >&5 + $as_echo "host=$host" >&6; } + +-PROCESSOR_FLAGS=${PROCESSOR_FLAGS:-""} +- + use=unknown +-TLDFLAGS="" + case $canonical in +- older) +- use=386-bsd;; +- +- sh4*linux*) +- use=sh4-linux;; +- +- *x86_64*linux*) +- use=amd64-linux;; +- +- *x86_64*kfreebsd*) +- use=amd64-kfreebsd;; +- +- *86*linux*) +- use=386-linux;; +- +- *86*kfreebsd*) +- use=386-kfreebsd;; +- +- *86*gnu*) +- use=386-gnu;; +- +-# m6800 not working with gcc-3.2 +- m68k*linux*) +- if test "$use_common_binary" = "yes"; then +- host=m68020-unknown-linux-gnu +- echo "The host is canonicalised to $host" +- fi +- use=m68k-linux;; +- +- alpha*linux*) +- use=alpha-linux;; +- +- mips*linux*) +- use=mips-linux;; +- +- mipsel*linux*) +- use=mipsel-linux;; +- +- sparc*linux*) +- use=sparc-linux;; +- +- aarch64*linux*) +- use=aarch64-linux;; +- +- arm*linux*) +- use=arm-linux;; +- +- s390*linux*) +- use=s390-linux;; +- +- ia64*linux*) +- use=ia64-linux;; +- +- hppa*linux*) +- use=hppa-linux;; +- +- powerpc*linux*) +- use=powerpc-linux;; +- +- powerpc-*-darwin*) +- use=powerpc-macosx;; +- +- *86*darwin*) +- use=386-macosx +- if test "$build_cpu" = "x86_64" ; then +- CFLAGS="-m64 $CFLAGS"; +- LDFLAGS="-m64 -Wl,-headerpad,72 -Wl,-no_pie $LDFLAGS"; +- else +- CFLAGS="-m32 $CFLAGS"; +- LDFLAGS="-m32 -Wl,-headerpad,56 -Wl,-no_pie $LDFLAGS"; ++ sh4*linux*) use=sh4-linux;; ++ *x86_64*linux*) use=amd64-linux;; ++ *x86_64*kfreebsd*) use=amd64-kfreebsd;; ++ *86*linux*) use=386-linux;; ++ *86*kfreebsd*) use=386-kfreebsd;; ++ *86*gnu*) use=386-gnu;; ++ m68k*linux*) use=m68k-linux;; ++ alpha*linux*) use=alpha-linux;; ++ mips*linux*) use=mips-linux;; ++ mipsel*linux*) use=mipsel-linux;; ++ sparc*linux*) use=sparc-linux;; ++ aarch64*linux*) use=aarch64-linux;; ++ arm*linux*) use=arm-linux;; ++ s390*linux*) use=s390-linux;; ++ ia64*linux*) use=ia64-linux;; ++ hppa*linux*) use=hppa-linux;; ++ powerpc*linux*) use=powerpc-linux;; ++ powerpc-*-darwin*) use=powerpc-macosx;; ++ *86*darwin*) use=386-macosx;; ++ i*mingw*|i*msys*) use=mingw;; ++ i*cygwin*) ++ if $CC -v 2>&1 | fgrep ming > /dev/null ; ++ then use=mingw ++ else use=gnuwin95 + fi;; ++ *openbsd*) use=FreeBSD;; ++ sparc-sun-solaris*) use=solaris;; ++ i?86-pc-solaris*) use=solaris-i386;; ++esac + +- alpha-dec-osf) +- use=alpha-osf1;; +- +- mips-dec-ultrix) +- use=dec3100;; +- +- old) +- use=dos-go32;; +- +- *86*-freebsd*) +- use=FreeBSD;; +- +- hp3*-*hpux*) +- use=hp300;; +- +- hp3*-*-*bsd*) +- use=hp300-bsd;; +- +- hppa*-*hpux*) +- use=hp800;; +- +- mips-sgi-irix) +- case $system in +- IRIX5*) +- use=irix5;; +- IRIX6*) +- use=irix6;; +- IRIX3*) +- use=sgi4d;; +- esac ;; +- +- +- m68k-apple-aux*) +- use=mac2;; +- +- old) +- use=mp386;; ++# Check whether --enable-machine was given. ++if test "${enable_machine+set}" = set; then : ++ enableval=$enable_machine; echo enable_machine=$enableval ; use=$enableval ++fi + +- *86-ncr-sysv4) +- use=ncr;; + +- *3-986-*netbsd*) +- use=NetBSD;; ++{ $as_echo "$as_me:${as_lineno-$LINENO}: result: use=$use" >&5 ++$as_echo "use=$use" >&6; } + +- old) +- use=NeXT;; ++def_dlopen="no" ++def_statsysbfd="no" ++def_custreloc="yes" ++def_oldgmp="no" ++def_pic="no"; ++def_static="no"; ++def_debug="no"; ++case $use in ++ *kfreebsd) ++ ln -snf linux.defs h/$use.defs;; ++ *gnu) ++ ln -snf linux.defs h/$use.defs;; ++ *linux) ++ ln -snf linux.defs h/$use.defs; ++ case $use in ++ ia64*) ++ def_dlopen="yes" ; def_custreloc="no" ;; ++ hppa*) ++ def_pic="yes" ;; ++ esac;; ++esac + +- old) +- use=NeXT30-m68k;; ++# Check whether --enable-widecons was given. ++if test "${enable_widecons+set}" = set; then : ++ enableval=$enable_widecons; if test "$enableval" = "yes" ; then ++$as_echo "#define WIDE_CONS 1" >>confdefs.h ++ fi ++fi + +- *86-*nextstep*) +- use=NeXT32-i386;; + +- *m68*-*nextstep*) +- use=NeXT32-m68k;; ++# Check whether --enable-safecdr was given. ++if test "${enable_safecdr+set}" = set; then : ++ enableval=$enable_safecdr; if test "$enableval" = "yes" ; then + +- *rs6000-*-aix4*) +- use=rios;; ++$as_echo "#define USE_SAFE_CDR 1" >>confdefs.h + +- *rs6000-*-aix3*) +- use=rios-aix3;; ++ # Check whether --enable-safecdrdbg was given. ++if test "${enable_safecdrdbg+set}" = set; then : ++ enableval=$enable_safecdrdbg; if test "$enableval" = "yes" ; then ++$as_echo "#define DEBUG_SAFE_CDR 1" >>confdefs.h ++ fi ++fi + +- old) +- use=rt_aix;; ++ fi ++fi + +- old) +- use=sgi;; + +- sparc-sun-solaris*) +- use=solaris;; ++# Check whether --enable-prelink was given. ++if test "${enable_prelink+set}" = set; then : ++ enableval=$enable_prelink; if test "$enable_prelink" = "yes" ; then PRELINK_CHECK=t; fi ++fi + +- i?86-pc-solaris*) +- use=solaris-i386;; + +- old) +- use=sun2r3;; + +- old) +- use=sun3;; ++# Check whether --enable-vssize was given. ++if test "${enable_vssize+set}" = set; then : ++ enableval=$enable_vssize; ++cat >>confdefs.h <<_ACEOF ++#define VSSIZE $enableval ++_ACEOF + +- m68*-sunos*) +- use=sun3-os4;; ++fi + +- old) +- use=sun386i;; ++# Check whether --enable-bdssize was given. ++if test "${enable_bdssize+set}" = set; then : ++ enableval=$enable_bdssize; ++cat >>confdefs.h <<_ACEOF ++#define BDSSIZE $enableval ++_ACEOF + +- sparc*sunos*) +- use=sun4;; ++fi + +- *86-sequent-dynix) +- use=symmetry;; ++# Check whether --enable-ihssize was given. ++if test "${enable_ihssize+set}" = set; then : ++ enableval=$enable_ihssize; ++cat >>confdefs.h <<_ACEOF ++#define IHSSIZE $enableval ++_ACEOF + +- u370*aix) +- use=u370_aix;; ++fi + +- old) +- use=vax;; ++# Check whether --enable-frssize was given. ++if test "${enable_frssize+set}" = set; then : ++ enableval=$enable_frssize; ++cat >>confdefs.h <<_ACEOF ++#define FRSSIZE $enableval ++_ACEOF + +- i*mingw*) +- if test "$use_common_binary" = "yes"; then +- host=i386-pc-mingw32 +- PROCESSOR_FLAGS="-march=i386 " +- echo "The host is canonicalised to $host" +- fi +- use=mingw;; ++fi + +- i*cygwin*) +- if $CC -v 2>&1 | fgrep ming > /dev/null ; +- then use=mingw +- else use=gnuwin95 +- fi;; + +- *openbsd*) +- # 'ld -Z' means disable W^X +- TLDFLAGS="$TLDFLAGS -Z" +- use=FreeBSD;; ++# Check whether --enable-infodir was given. ++if test "${enable_infodir+set}" = set; then : ++ enableval=$enable_infodir; INFO_DIR=$enableval ++else ++ INFO_DIR=$prefix/share/info ++fi + +-esac ++INFO_DIR=`eval echo $INFO_DIR/` + ++# Check whether --enable-emacsdir was given. ++if test "${enable_emacsdir+set}" = set; then : ++ enableval=$enable_emacsdir; EMACS_SITE_LISP=$enableval ++else ++ EMACS_SITE_LISP=$prefix/share/emacs/site-lisp ++fi + ++EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` + +-echo enable_machine=$enable_machine +-if test "x$enable_machine" != "x" ; then +- use=$enable_machine ++# Check whether --enable-xgcl was given. ++if test "${enable_xgcl+set}" = set; then : ++ enableval=$enable_xgcl; ++else ++ enable_xgcl=yes + fi + +-def_dlopen="no" +-def_statsysbfd="no" +-def_custreloc="yes" +-#def_statsysbfd="yes" +-#def_custreloc="no" +-def_locbfd="no" +-def_oldgmp="no" +-def_pic="no"; +-def_static="no"; +-def_debug="no"; +-case $use in +- *kfreebsd) +- ln -snf linux.defs h/$use.defs;; +- *gnu) +- ln -snf linux.defs h/$use.defs;; +- *linux) +- ln -snf linux.defs h/$use.defs; +- case $use in +-# def_static -- Function descriptors are currently realized at runtime in a non-reproducible fashion +-# on these architectures -- CM +- powerpc*) +-# if test "$host_cpu" = "powerpc64" ; then def_dlopen="yes" ; def_custreloc="no" ; fi +- ;; +- ia64*) +- def_dlopen="yes" ; def_custreloc="no" ;; +- hppa*) +- def_pic="yes" ;; +-# def_dlopen="yes" ; def_custreloc="no" ; def_pic="yes" ;; +- esac;; +-esac + + # Check whether --enable-dlopen was given. + if test "${enable_dlopen+set}" = set; then : + enableval=$enable_dlopen; + else +- enable_dlopen="$def_dlopen" ++ enable_dlopen=$def_dlopen + fi + + # Check whether --enable-statsysbfd was given. + if test "${enable_statsysbfd+set}" = set; then : + enableval=$enable_statsysbfd; + else +- enable_statsysbfd="$def_statsysbfd" ++ enable_statsysbfd=$def_statsysbfd + fi + + # Check whether --enable-dynsysbfd was given. + if test "${enable_dynsysbfd+set}" = set; then : + enableval=$enable_dynsysbfd; + else +- enable_dynsysbfd="no" ++ enable_dynsysbfd=no + fi + +-#AC_ARG_ENABLE(locbfd, +-# [ --enable-locbfd uses a static bfd library built from this source tree for loading and relocationing object files ] +-# ,,enable_locbfd="$def_locbfd") + # Check whether --enable-custreloc was given. + if test "${enable_custreloc+set}" = set; then : + enableval=$enable_custreloc; + else +- enable_custreloc="$def_custreloc" ++ enable_custreloc=$def_custreloc + fi + ++ + # Check whether --enable-debug was given. + if test "${enable_debug+set}" = set; then : + enableval=$enable_debug; + else +- enable_debug="$def_debug" +-fi +- +-# Check whether --enable-gprof was given. +-if test "${enable_gprof+set}" = set; then : +- enableval=$enable_gprof; +-else +- enable_gprof="no" ++ enable_debug=$def_debug + fi + + # Check whether --enable-static was given. + if test "${enable_static+set}" = set; then : +- enableval=$enable_static; enable_static=$enableval ++ enableval=$enable_static; + else +- enable_static="$def_static" ++ enable_static=$def_static + fi + + # Check whether --enable-pic was given. + if test "${enable_pic+set}" = set; then : + enableval=$enable_pic; + else +- enable_pic="$def_pic" +-fi +- +- +-# Check whether --enable-oldgmp was given. +-if test "${enable_oldgmp+set}" = set; then : +- enableval=$enable_oldgmp; +-else +- enable_oldgmp="$def_oldgmp" ++ enable_pic=$def_pic + fi + + +-# Check whether --enable-dynsysgmp was given. +-if test "${enable_dynsysgmp+set}" = set; then : +- enableval=$enable_dynsysgmp; +-else +- enable_dynsysgmp="yes" +-fi +- +- +-load_opt="0" ++load_opt=0 + if test "$enable_dlopen" = "yes" ; then +- load_opt=1 ++ load_opt=1 + fi + if test "$enable_statsysbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ esac + fi + if test "$enable_dynsysbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- esac +-fi +-if test "$enable_locbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- 3) load_opt=4;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ 2) load_opt=3;; ++ esac + fi + if test "$enable_custreloc" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- 3) load_opt=4;; +- 4) load_opt=5;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ 2) load_opt=3;; ++ 3) load_opt=4;; ++ 4) load_opt=5;; ++ esac + fi + + if test "$load_opt" != "1" ; then +- echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd locbfd=$enable_locbfd custreloc=$enable_custreloc" +- exit 1 ++ echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd custreloc=$enable_custreloc" ++ as_fn_error $? "loader option failure" "$LINENO" 5 + fi + +-TLDFLAGS="" +-if test "$enable_static" = "yes" ; then +- TLDFLAGS="-static -Wl,-zmuldefs $TLDFLAGS"; #FIXME should be in unixport/makefile +- +-$as_echo "#define STATIC_LINKING 1" >>confdefs.h +- +-fi +-case $use in +- *gnuwin*) +- TLDFLAGS="$TLDFLAGS -Wl,--stack,8000000";; +-esac +- +-## finally warn if we did not find a recognized machine.s +-## +-#if test "$use" = "unknown" ; then +-#types=`echo h/*.defs` | sed -e "s:h/::g" -e "s:\.defs:g"` +-#echo got canonical=$canonical, but was not recognized. +-#echo Unable to guess type to use. Try one of +-#exit(1) +-#fi +- +-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: use=$use" >&5 +-$as_echo "use=$use" >&6; } +- + + # + # System programs +@@ -3238,10 +2914,10 @@ $as_echo "use=$use" >&6; } + # We set the default CFLAGS below, and don't want the autoconf default + # CM 20040106 + if test "$CFLAGS" = "" ; then +- CFLAGS=" " ++ CFLAGS=" " + fi + if test "$LDFLAGS" = "" ; then +- LDFLAGS=" " ++ LDFLAGS=" " + fi + + ac_ext=c +@@ -4171,74 +3847,90 @@ ac_link='$CC -o conftest$ac_exeext $CFLA + ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ++GCL_CC=`basename $CC` ++if echo $GCL_CC |grep gcc |grep -q win; then ++ GCL_CC=gcc ++fi + + +-# can only test for numbers -- CM +-# if test "${GCC}" -eq "yes" ; then +-#if [[ "${GCC}" = "yes" ]] ; then +-# Allog for environment variable overrides on compiler selection -- CM +-#GCC=$CC +-#else +-#GCC="" +-#fi +-# subst GCC not only under 386-linux, but where available -- CM +- +-TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" +- +-if test "$GCC" = "yes" ; then +- +- TCFLAGS="$TCFLAGS -Wall" ++add_arg_to_tcflags() { + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 +-$as_echo_n "checking for clang... " >&6; } ++ local i=1 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $1" >&5 ++$as_echo_n "checking for CFLAG $1... " >&6; } ++ CFLAGS_ORI=$CFLAGS ++ CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" + + if test "$cross_compiling" = yes; then : +- { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +-as_fn_error $? "cannot run test program while cross compiling +-See \`config.log' for more details" "$LINENO" 5; } ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + ++int ++main () ++{ + +- int main() { +- return +- #ifdef __clang__ +- 0 +- #else +- 1 +- #endif +- ;} ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +-$as_echo "yes" >&6; } +- clang="yes" +- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" +- +-$as_echo "#define CLANG 1" >>confdefs.h +- ++ TCFLAGS="$TCFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; };i=0 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +- #FIXME -Wno-unused-but-set-variable when time +- TMPF=-Wno-unused-but-set-variable +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $TMPF" >&5 +-$as_echo_n "checking for CFLAG $TMPF... " >&6; } +- CFLAGS_ORI=$CFLAGS +- CFLAGS="$CFLAGS $TMPF" +- if test "$cross_compiling" = yes; then : ++fi ++rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ ++ conftest.$ac_objext conftest.beam conftest.$ac_ext ++fi ++ ++ CFLAGS=$CFLAGS_ORI ++ return $i ++ ++} ++ ++assert_arg_to_tcflags() { ++ if ! add_arg_to_tcflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to CFLAGS" >&5 ++$as_echo "cannot add $1 to CFLAGS" >&6; }; exit 1 ; fi ++ return 0 ++} ++ ++add_args_to_tcflags() { ++ ++ while test "$#" -ge 1 ; do ++ add_arg_to_tcflags $1 ++ shift ++ done ++} ++ ++add_arg_to_tldflags() { ++ ++ local i=1 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LDFLAG $1" >&5 ++$as_echo_n "checking for LDFLAG $1... " >&6; } ++ LDFLAGS_ORI=$LDFLAGS ++ LDFLAGS="$LDFLAGS -Werror $1" ++ if test "$cross_compiling" = yes; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-int main() {return 0;} ++ ++int ++main () ++{ ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- TCFLAGS="$TCFLAGS $TMPF";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +-$as_echo "yes" >&6; } ++ TLDFLAGS="$TLDFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; };i=0 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +@@ -4247,48 +3939,136 @@ rm -f core *.core core.conftest.* gmon.o + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- CFLAGS=$CFLAGS_ORI ++ LDFLAGS=$LDFLAGS_ORI ++ return $i ++ ++} ++ ++assert_arg_to_tldflags() { ++ if ! add_arg_to_tldflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to LDFLAGS" >&5 ++$as_echo "cannot add $1 to LDFLAGS" >&6; }; exit 1 ; fi ++ return 0 ++} ++ ++add_args_to_tldflags() { ++ ++ while test "$#" -ge 1 ; do ++ add_arg_to_tldflags $1 ++ shift ++ done ++} ++ ++remove_arg_from_ldflags() { ++ ++ NEW_LDFLAGS="" ++ for i in $LDFLAGS; do ++ if ! test "$i" = "$1" ; then ++ NEW_LDFLAGS="$NEW_LDFLAGS $i" ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: removing $1 from LDFLAGS" >&5 ++$as_echo "removing $1 from LDFLAGS" >&6; } ++ fi ++ done ++ LDFLAGS=$NEW_LDFLAGS ++ ++ return 0 ++ ++} ++ ++TCFLAGS="" ++add_args_to_tcflags -fsigned-char -pipe \ ++ -fno-builtin-malloc -fno-builtin-free \ ++ -fno-PIE -fno-pie -fno-PIC -fno-pic \ ++ -Wall \ ++ -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ ++ -Wno-unused-but-set-variable -Wno-misleading-indentation ++ ++TLDFLAGS="" ++add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++ ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 ++$as_echo_n "checking for clang... " >&6; } ++if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } ++else ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++/* end confdefs.h. */ ++ ++ #ifdef __clang__ ++ #define RET 0 ++ #else ++ #define RET 1 ++ #endif ++ ++int ++main () ++{ ++ ++ return RET; ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; } ++ clang="yes" ++ remove_arg_from_ldflags -pie ++ ++$as_echo "#define CLANG 1" >>confdefs.h ++ ++else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++$as_echo "no" >&6; } + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +-fi + +-if test "$GCC" = "yes" ; then +- TCFLAGS="$TCFLAGS -pipe" +- case $use in +- *mingw*) +-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +-# echo " It is otherwise needed for the Unexec stuff to work." +-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; +- *gnuwin*) +-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +-# echo " It is otherwise needed for the Unexec stuff to work." +-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; +- esac +-fi +-#if test -f /proc/sys/kernel/exec-shield ; then +-# exec_stat=`cat /proc/sys/kernel/exec-shield` +-# if test "$exec_stat" != "0" ; then +-# # CFLAGS here to hopefully cover the DBEGIN routine below +-# CFLAGS="$CFLAGS -Wa,--execstack" +-# fi +-#fi ++case $use in ++ *mingw*) ++ assert_arg_to_tcflags -fno-zero-initialized-in-bss ++ assert_arg_to_tcflags -mms-bitfields;; ++ *gnuwin*) ++ assert_arg_to_tcflags -fno-zero-initialized-in-bss ++ assert_arg_to_tcflags -mms-bitfields ++ assert_arg_to_tldflags -Wl,--stack,8000000;; ++ 386-macosx) ++ assert_arg_to_tldflags -Wl,-no_pie ++ if test "$build_cpu" = "x86_64" ; then ++ assert_arg_to_tcflags -m64 ++ assert_arg_to_tldflags -m64 ++ assert_arg_to_tldflags -Wl,-headerpad,72 ++ else ++ assert_arg_to_tcflags -m32 ++ assert_arg_to_tldflags -m32 ++ assert_arg_to_tldflags -Wl,-headerpad,56 ++ fi;; ++ FreeBSD) assert_arg_to_tldflags -Z;; ++esac ++ ++if test "$enable_static" = "yes" ; then ++ assert_arg_to_tldflags -static ++ assert_arg_to_tldflags -Wl,-zmuldefs ++ ++$as_echo "#define STATIC_LINKING 1" >>confdefs.h ++ ++fi + + TO3FLAGS="" + TO2FLAGS="" + +-#TFPFLAG="-fomit-frame-pointer" +-# FIXME -- remove when mingw compiler issues are fixed + case "$use" in +- *mingw*) ++ *mingw*) + TFPFLAG="";; +- m68k*)#FIXME gcc 4.x bug workaround ++ m68k*)#FIXME gcc 4.x bug workaround + TFPFLAG="";; +- *) ++ *) + TFPFLAG="-fomit-frame-pointer";; + esac + +@@ -4335,143 +4115,104 @@ fi + done + + +-# Work around system/gprof mips/hppa hang +-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking working gprof" >&5 ++# Check whether --enable-gprof was given. ++if test "${enable_gprof+set}" = set; then : ++ enableval=$enable_gprof; if test "$enableval" = "yes" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking working gprof" >&5 + $as_echo_n "checking working gprof... " >&6; } +-old_enable_gprof=$enable_gprof +-case $use in +- powerpc*) if test "$host_cpu" = "powerpc64le" ; then enable_gprof="no"; fi;; +- sh4*) enable_gprof="no";; +- ia64*) enable_gprof="no";; +-# mips*) enable_gprof="no";; +- hppa*) enable_gprof="no";; +- arm*) enable_gprof="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +- *gnu) enable_gprof="no";; +-esac +-if test "$enable_gprof" = "$old_enable_gprof" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 +-$as_echo "ok" >&6; } +-else +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 ++ case $use in ++ powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ *gnu) enableval="no";; ++ esac ++ if test "$enableval" != "yes" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5 + $as_echo "disabled" >&6; } +-fi +- +-if test "$enable_gprof" = "yes" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5 ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 ++$as_echo "ok" >&6; } ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5 + $as_echo_n "checking for text start... " >&6; } +- echo 'int main () {return(0);}' >foo.c +- $CC foo.c -o foo +- GCL_GPROF_START=`nm foo | $AWK '/ *[TD] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +- rm -f foo.c foo +- if test "$GCL_GPROF_START" != "" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCL_GPROF_START" >&5 ++ echo 'int main () {return(0);}' >foo.c ++ $CC foo.c -o foo ++ GCL_GPROF_START=`nm foo | $AWK '/ *[TD] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++ rm -f foo.c foo ++ if test "$GCL_GPROF_START" != "" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCL_GPROF_START" >&5 + $as_echo "$GCL_GPROF_START" >&6; } + + cat >>confdefs.h <<_ACEOF + #define GCL_GPROF_START $GCL_GPROF_START + _ACEOF + +- case "$use" in +- arm*) +- #FIXME report and remove this when done +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: Reducing optimization on profiling arm build to workaround gcc bug" >&5 +-$as_echo "Reducing optimization on profiling arm build to workaround gcc bug" >&6; } +- enable_debug=yes;; +- esac +- TCFLAGS="$TCFLAGS -pg"; +- case $use in +- s390*) ;; # relocation truncation bug in gcc +- *) TLIBS="$TLIBS -pg";; +- esac +- TFPFLAG="" ++ assert_arg_to_tcflags -pg ++ case $use in ++ s390*) ;; # relocation truncation bug in gcc ++ *) TLIBS="$TLIBS -pg";; ++ esac ++ TFPFLAG="" + + $as_echo "#define GCL_GPROF 1" >>confdefs.h + +- else +- enable_gprof="no"; +- fi +-fi +- +-if $CC -v 2>&1 | tail -1 | grep "gcc version 4.6.1" >/dev/null ; then +- case "$use" in +- arm*) +- #FIXME report and remove this when done +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: Reducing optimization on arm build to workaround gcc 4.6 bug" >&5 +-$as_echo "Reducing optimization on arm build to workaround gcc 4.6 bug" >&6; } +- enable_debug=yes;; +- esac ++ fi ++ fi ++ fi + fi + + + if test "$enable_debug" = "yes" ; then +- TCFLAGS="$TCFLAGS -g" +- # for subconfigurations +- CFLAGS="$CFLAGS -g" ++ assert_arg_to_tcflags -g ++ # for subconfigurations ++ CFLAGS="$CFLAGS -g" + else +- TO3FLAGS="-O3 $TFPFLAG" +- TO2FLAGS="-O" ++ TO3FLAGS="-O3 $TFPFLAG" ++ TO2FLAGS="-O" + fi + + # gcc on ppc cannot compile our new_init.c with full opts --CM + TONIFLAGS="" + case $use in +- powerpc*macosx) +- TCFLAGS="$TCFLAGS -mlongcall";; +- *linux) ++ powerpc*macosx) assert_arg_to_tcflags -mlongcall;; ++ *linux) + case $use in +-# amd64*) # stack-boundary option does not work +-# TCFLAGS="$TCFLAGS -m64 -mpreferred-stack-boundary=8";; +- alpha*) +- TCFLAGS="$TCFLAGS -mieee" +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 +- ;; +-# m68k*) +-# TCFLAGS="$TCFLAGS -ffloat-store";; +- aarch64*) +- TLIBS="$TLIBS -lgcc_s";; +- hppa*) +- TCFLAGS="$TCFLAGS -mlong-calls " +- TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 +-# TCFLAGS="$TCFLAGS -ffunction-sections" +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O $TFPFLAG" ; fi +-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi +- ;; +- mips*) +- case $canonical in +- mips64*linux*) +- TLIBS="$TLIBS -Wl,-z -Wl,now";; +- esac +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 +- ;; +- ia64*) +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 +- ;; +- arm*) +- TCFLAGS="$TCFLAGS -mlong-calls -fdollars-in-identifiers -g " +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.6.2 +-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi +- ;; +- powerpc*) +- TCFLAGS="$TCFLAGS -mlongcall" +- ;; +-# if $CC -v 2>&1 | grep -q "gcc version 3.2" ; then +-# echo Reducing optimization for buggy gcc-3.2 +-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +-# fi; +-# echo Probing for longcall +-# if ! $CC -v 2>&1 | $AWK '/^gcc version / {split($3,A,".");if (A[[1]]+0>3 || (A[[1]]+0>=3 && A[[2]]+0>=3)) exit 1;}'; then +-# echo Enabling longcall on gcc 3.3 or later +-# TCFLAGS="$TCFLAGS -mlongcall" +-# echo Reducing optimization for buggy gcc 3.3 or later +-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +-# fi;; ++ alpha*) ++ assert_arg_to_tcflags -mieee ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ aarch64*) ++ TLIBS="$TLIBS -lgcc_s";; ++ hppa*) ++ assert_arg_to_tcflags -mlong-calls ++ TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ mips*) ++ case $canonical in ++ mips64*linux*) ++ assert_arg_to_tldflags -Wl,-z,now;; ++ esac ++ ;; ++ ia64*) ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ arm*) ++ assert_arg_to_tcflags -mlong-calls ++ assert_arg_to_tcflags -fdollars-in-identifiers ++ assert_arg_to_tcflags -g #? ++ ;; ++ powerpc*) ++ assert_arg_to_tcflags -mlongcall ++ ;; + esac;; + esac + if test "$enable_pic" = "yes" ; then +- TCFLAGS="$TCFLAGS -fPIC" ++ assert_arg_to_tcflags -fPIC + fi + ++ + FDEBUG=`echo $CFLAGS | tr ' ' '\012' |grep "^\-g$"|tr '\012' ' '` + #CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-g$"` + FOMITF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-fomit-frame-pointer$"|tr '\012' ' '` +@@ -4488,27 +4229,27 @@ FOOPT0=`echo $CFLAGS | tr ' ' '\012' |gr + CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O0$"|tr '\012' ' '` + + if test "$FOOPT0" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[123 ],-O0 ,g' | sed 's,\-O$,-O0 ,g'` + else +-if test "$FOOPT1" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[2-3],-O1,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[2-3],-O1,g'` +-else +-if test "$FOOPT2" != "" ; then +- TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` +- TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` +-fi +-fi ++ if test "$FOOPT1" != "" ; then ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[2-3],-O1,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[2-3],-O1,g'` ++ else ++ if test "$FOOPT2" != "" ; then ++ TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` ++ TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` ++ fi ++ fi + fi + + if test "$FDEBUG" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` + fi + + if test "$FOMITF" != "" ; then +- TO3FLAGS="$TO3FLAGS $FOMITF" ++ TO3FLAGS="$TO3FLAGS $FOMITF" + fi + + # Step 1: set the variable "system" to hold the name and version number +@@ -4569,8 +4310,8 @@ if test -f /usr/lib/NextStep/software_ve + else + system=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: unknown (can't find uname command)" >&5 +-$as_echo "unknown (can't find uname command)" >&6; } ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: unknown (cannot find uname command)" >&5 ++$as_echo "unknown (cannot find uname command)" >&6; } + system=unknown + else + # Special check for weird MP-RAS system (uname returns weird +@@ -4588,7 +4329,7 @@ $as_echo "$system" >&6; } + fi + + case $use in +- *macosx) ++ *macosx) + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 + $as_echo_n "checking for grep that handles long lines and -e... " >&6; } +@@ -4864,7 +4605,7 @@ fi + done + + ac_fn_c_check_member "$LINENO" "struct _malloc_zone_t" "memalign" "ac_cv_member_struct__malloc_zone_t_memalign" " +- #include ++ #include + + " + if test "x$ac_cv_member_struct__malloc_zone_t_memalign" = xyes; then : +@@ -4877,7 +4618,6 @@ fi + ;; + esac + +- + for ac_header in setjmp.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "setjmp.h" "ac_cv_header_setjmp_h" "$ac_includes_default" +@@ -4887,7 +4627,7 @@ if test "x$ac_cv_header_setjmp_h" = xyes + _ACEOF + { $as_echo "$as_me:${as_lineno-$LINENO}: checking sizeof jmp_buf" >&5 + $as_echo_n "checking sizeof jmp_buf... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -4896,19 +4636,24 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + ++ #include ++ #include + +- #include +- #include +- int main() { +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%lu\n",sizeof(jmp_buf)); +- fclose(fp); +- return 0; +- } ++int ++main () ++{ ++ ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%lu\n",sizeof(jmp_buf)); ++ fclose(fp); ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + sizeof_jmp_buf=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_jmp_buf" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_jmp_buf" >&5 + $as_echo "$sizeof_jmp_buf" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -4929,7 +4674,6 @@ done + + + # sysconf +- + for ac_header in unistd.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "unistd.h" "ac_cv_header_unistd_h" "$ac_includes_default" +@@ -4944,52 +4688,6 @@ if ${ac_cv_lib_c_sysconf+:} false; then + else + ac_check_lib_save_LIBS=$LIBS + LIBS="-lc $LIBS" +- +-# ac_fn_c_try_link LINENO +-# ----------------------- +-# Try to link conftest.$ac_ext, and return whether this succeeded. +-ac_fn_c_try_link () +-{ +- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack +- rm -f conftest.$ac_objext conftest$ac_exeext +- if { { ac_try="$ac_link" +-case "(($ac_try" in +- *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; +- *) ac_try_echo=$ac_try;; +-esac +-eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +-$as_echo "$ac_try_echo"; } >&5 +- (eval "$ac_link") 2>conftest.err +- ac_status=$? +- if test -s conftest.err; then +- grep -v '^ *+' conftest.err >conftest.er1 +- cat conftest.er1 >&5 +- mv -f conftest.er1 conftest.err +- fi +- $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 +- test $ac_status = 0; } && { +- test -z "$ac_c_werror_flag" || +- test ! -s conftest.err +- } && test -s conftest$ac_exeext && { +- test "$cross_compiling" = yes || +- test -x conftest$ac_exeext +- }; then : +- ac_retval=0 +-else +- $as_echo "$as_me: failed program was:" >&5 +-sed 's/^/| /' conftest.$ac_ext >&5 +- +- ac_retval=1 +-fi +- # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information +- # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would +- # interfere with the next link command; also delete a directory that is +- # left behind by Apple's compiler. We do this before executing the actions. +- rm -rf conftest.dSYM conftest_ipa8_conftest.oo +- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno +- as_fn_set_status $ac_retval +- +-} # ac_fn_c_try_link + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +@@ -5022,39 +4720,40 @@ $as_echo "$ac_cv_lib_c_sysconf" >&6; } + if test "x$ac_cv_lib_c_sysconf" = xyes; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking _SC_CLK_TCK" >&5 + $as_echo_n "checking _SC_CLK_TCK... " >&6; } +- if test "$cross_compiling" = yes; then : +- hz=0 ++ hz=0 ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #include +- int +- main() { +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); +- fclose(fp); +- return 0; +- } +-_ACEOF +-if ac_fn_c_try_run "$LINENO"; then : +- hz=`cat conftest1` + +-cat >>confdefs.h <<_ACEOF +-#define HZ $hz +-_ACEOF ++ #include ++ #include + ++int ++main () ++{ ++ ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); ++ fclose(fp); ++ ++ ; ++ return 0; ++} ++_ACEOF ++if ac_fn_c_try_run "$LINENO"; then : + +-else +- hz=0 + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hz" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hz" >&5 + $as_echo "$hz" >&6; } +- + fi + + fi +@@ -5063,20 +4762,16 @@ done + + + +-#MY_SUBDIRS= +- +-# +-# GMP +-# +- + rm -f makedefsafter + +-MP_INCLUDE="" +-if test $use_gmp = yes ; then ++# Check whether --enable-dynsysgmp was given. ++if test "${enable_dynsysgmp+set}" = set; then : ++ enableval=$enable_dynsysgmp; ++fi ++ + +- PATCHED_SYMBOLS="" +- if test "$enable_dynsysgmp" = "yes" ; then +- for ac_header in gmp.h ++if test "$enable_dynsysgmp" != "no" ; then ++ for ac_header in gmp.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "gmp.h" "ac_cv_header_gmp_h" "$ac_includes_default" + if test "x$ac_cv_header_gmp_h" = xyes; then : +@@ -5120,100 +4815,97 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_init" >&5 + $as_echo "$ac_cv_lib_gmp___gmpz_init" >&6; } + if test "x$ac_cv_lib_gmp___gmpz_init" = xyes; then : +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for external gmp version\"" >&5 +-$as_echo_n "checking \"for external gmp version\"... " >&6; } +- if test "$cross_compiling" = yes; then : +- echo "Cannot use dynamic gmp lib" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for external gmp version" >&5 ++$as_echo_n "checking for external gmp version... " >&6; } ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- int main() { +- #if __GNU_MP_VERSION > 3 +- return 0; +- #else +- return -1; +- #endif +- } ++ ++ #include ++ ++int ++main () ++{ ++ ++ #if __GNU_MP_VERSION > 3 ++ return 0; ++ #else ++ return -1; ++ #endif ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- # MPFILES=$GMPDIR/mpn/mul_n.o +-# PATCHED_SYMBOLS=__gmpn_toom3_mul_n +- MPFILES= +- PATCHED_SYMBOLS= +-# if test "$use" = "m68k-linux" ; then +-# MPFILES="$MPFILES $GMPDIR/mpn/lshift.o $GMPDIR/mpn/rshift.o" +-# PATCHED_SYMBOLS="$PATCHED_SYMBOLS __gmpn_lshift __gmpn_rshift" +-# fi +- TLIBS="$TLIBS -lgmp" +- echo "#include \"gmp.h\"" >foo.c +- echo "int main() {return 0;}" >>foo.c +- MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` +- rm -f foo.c +-else +- echo "Cannot use dynamic gmp lib" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: good" >&5 ++$as_echo "good" >&6; } ++ TLIBS="$TLIBS -lgmp" ++ echo "#include \"gmp.h\"" >foo.c ++ echo "int main() {return 0;}" >>foo.c ++ MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` ++ rm -f foo.c + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +-else +- echo "Cannot use dynamic gmp lib" + fi + +-else +- echo "Cannot use dynamic gmp lib" + fi + + done + ++ ++ if test "$MP_INCLUDE" = "" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Cannot use dynamic gmp lib" >&5 ++$as_echo "Cannot use dynamic gmp lib" >&6; } ++ fi ++ + fi + +-NEED_LOCAL_GMP='' ++ + if test "$MP_INCLUDE" = "" ; then +- NEED_LOCAL_GMP=1; +-fi +-if test "$PATCHED_SYMBOLS" != "" ; then +- NEED_LOCAL_GMP=1; +-fi + +-if test "$NEED_LOCAL_GMP" != "" ; then ++ GMPDIR=gmp4 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking doing configure in gmp directory" >&5 ++$as_echo_n "checking doing configure in gmp directory... " >&6; } ++ echo ++ echo "#" ++ echo "#" ++ echo "# -------------------" ++ echo "# Subconfigure of GMP" ++ echo "#" ++ echo "#" + +- GMPDIR=gmp4 +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking use_gmp=yes, doing configure in gmp directory" >&5 +-$as_echo_n "checking use_gmp=yes, doing configure in gmp directory... " >&6; } +- echo +- echo "#" +- echo "#" +- echo "# -------------------" +- echo "# Subconfigure of GMP" +- echo "#" +- echo "#" +- +- if test "$use_common_binary" = "yes"; then +- cd $GMPDIR && ./configure --build=$host && cd .. +- else +- cd $GMPDIR && ./configure && cd .. +- fi +- #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" +- +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of GMP done" +- echo "# ------------------------" +- echo "#" +- +- if test "$MP_INCLUDE" = "" ; then +- cp $GMPDIR/gmp.h h/gmp.h +- MP_INCLUDE=h/gmp.h +- MPFILES=gmp_all +- fi ++ if test "$use_common_binary" = "yes"; then ++ cd $GMPDIR && ./configure --build=$host && cd .. ++ else ++ cd $GMPDIR && ./configure --host=$host --build=$build && cd .. ++ fi ++ #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" + ++ echo "#" ++ echo "#" ++ echo "#" ++ echo "# Subconfigure of GMP done" ++ echo "# ------------------------" ++ echo "#" ++ ++ if test "$MP_INCLUDE" = "" ; then ++ cp $GMPDIR/gmp.h h/gmp.h ++ MP_INCLUDE=h/gmp.h ++ MPFILES=gmp_all ++ fi + fi + +-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking \"for leading underscore in object symbols\"" >&5 +-$as_echo_n "checking \"for leading underscore in object symbols\"... " >&6; } ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for leading underscore in object symbols" >&5 ++$as_echo_n "checking for leading underscore in object symbols... " >&6; } + cat>foo.c < + #include +@@ -5221,15 +4913,15 @@ int main() {FILE *f;double d=0.0;getc(f) + EOFF + $CC -c foo.c -o foo.o + if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then +- LEADING_UNDERSCORE=1 ++ LEADING_UNDERSCORE=1 + + $as_echo "#define LEADING_UNDERSCORE 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 + $as_echo "\"yes\"" >&6; } + else +- LEADING_UNDERSCORE="" +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 ++ LEADING_UNDERSCORE="" ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 + $as_echo "\"no\"" >&6; } + fi + +@@ -5239,16 +4931,16 @@ $as_echo_n "checking \"for GNU ld option + touch map + $CC -o foo -Wl,-Map map foo.o >/dev/null 2>&1 + if test `cat map | wc -l` != "0" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"yes\"" >&5 + $as_echo "\"yes\"" >&6; } + + $as_echo "#define HAVE_GNU_LD 1" >>confdefs.h + +- GNU_LD=1 ++ GNU_LD=1 + else +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: \"no\"" >&5 + $as_echo "\"no\"" >&6; } +- GNU_LD= ++ GNU_LD= + fi + rm -f foo.c foo.o foo map + +@@ -5263,17 +4955,16 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include "$MP_INCLUDE" ++ #include ++ #include "$MP_INCLUDE" + + int + main () + { + +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%u",sizeof(mp_limb_t)); +- fclose(fp); +- return 0; ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%u",sizeof(mp_limb_t)); ++ fclose(fp); + + ; + return 0; +@@ -5307,18 +4998,18 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include "$MP_INCLUDE" ++ #include ++ #include "$MP_INCLUDE" + + int + main () + { + +- #ifdef _SHORT_LIMB +- return 0; +- #else +- return 1; +- #endif ++ #ifdef _SHORT_LIMB ++ return 0; ++ #else ++ return 1; ++ #endif + + ; + return 0; +@@ -5349,18 +5040,18 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include "$MP_INCLUDE" ++ #include ++ #include "$MP_INCLUDE" + + int + main () + { + +- #ifdef _LONG_LONG_LIMB +- return 0; +- #else +- return 1; +- #endif ++ #ifdef _LONG_LONG_LIMB ++ return 0; ++ #else ++ return 1; ++ #endif + + ; + return 0; +@@ -5380,17 +5071,17 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- GMP=1 ++GMP=1 + + $as_echo "#define GMP 1" >>confdefs.h + + + +- echo > makedefsafter +- echo "MPFILES=$MPFILES" >> makedefsafter +- echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter +- echo >> makedefsafter +-fi ++echo > makedefsafter ++echo "MPFILES=$MPFILES" >> makedefsafter ++echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter ++echo >> makedefsafter ++ + + + # +@@ -5399,7 +5090,7 @@ fi + + if test "$enable_xgcl" = "yes" ; then + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5 + $as_echo_n "checking for X... " >&6; } + + +@@ -5592,24 +5283,14 @@ else + $as_echo "libraries $x_libraries, headers $x_includes" >&6; } + fi + +-# AC_PATH_XTRA +-# echo $X_CFLAGS +-# echo $X_LIBS +-# echo $X_EXTRA_LIBS +-# echo $X_PRE_LIBS +- +- miss=0 +-# AC_CHECK_LIB(Xmu,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#FIXME remove these +-# AC_CHECK_LIB(Xt,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) +-# AC_CHECK_LIB(Xext,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) +-# AC_CHECK_LIB(Xaw,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#until here +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lX11" >&5 ++ ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lX11" >&5 + $as_echo_n "checking for main in -lX11... " >&6; } + if ${ac_cv_lib_X11_main+:} false; then : + $as_echo_n "(cached) " >&6 + else + ac_check_lib_save_LIBS=$LIBS +-LIBS="-lX11 $X_LIBS $LIBS" ++LIBS="-lX11 $LIBS" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +@@ -5635,22 +5316,14 @@ fi + $as_echo "$ac_cv_lib_X11_main" >&6; } + if test "x$ac_cv_lib_X11_main" = xyes; then : + X_LIBS="$X_LIBS -lX11" ++$as_echo "#define HAVE_XGCL 1" >>confdefs.h ++ + else +- miss=1 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: missing x libraries -- cannot compile xgcl" >&5 ++$as_echo "missing x libraries -- cannot compile xgcl" >&6; } + fi + + +- if test "$miss" = "1" ; then +- X_CFLAGS= +- X_LIBS= +- X_EXTRA_LIBS= +- X_PRE_LIBS= +- echo missing x libraries -- cannot compile xgcl +- else +- +-$as_echo "#define HAVE_XGCL 1" >>confdefs.h +- +- fi + fi + + +@@ -5663,7 +5336,7 @@ fi + + if test "$enable_dlopen" = "yes" ; then + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 + $as_echo_n "checking for dlopen in -ldl... " >&6; } + if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -5700,25 +5373,27 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 + $as_echo "$ac_cv_lib_dl_dlopen" >&6; } + if test "x$ac_cv_lib_dl_dlopen" = xyes; then : +- have_dl=1 ++ cat >>confdefs.h <<_ACEOF ++#define HAVE_LIBDL 1 ++_ACEOF ++ ++ LIBS="-ldl $LIBS" ++ + else +- have_dl=0 ++ as_fn_error $? "Cannot find dlopen" "$LINENO" 5 + fi + +- if test "$have_dl" = "0" ; then +- echo "Cannot find dlopen in -dl" +- exit 1 +- fi + +- TLIBS="$TLIBS -ldl -rdynamic" +- TCFLAGS="-fPIC $TCFLAGS" ++ TLIBS="$TLIBS -ldl -rdynamic" ++ assert_arg_to_tcflags -fPIC + + $as_echo "#define USE_DLOPEN 1" >>confdefs.h + ++ + fi + + if test "$enable_statsysbfd" = "yes" || test "$enable_dynsysbfd" = "yes" ; then +- for ac_header in bfd.h ++ for ac_header in bfd.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "bfd.h" "ac_cv_header_bfd_h" "$ac_includes_default" + if test "x$ac_cv_header_bfd_h" = xyes; then : +@@ -5763,18 +5438,28 @@ fi + $as_echo "$ac_cv_lib_bfd_bfd_init" >&6; } + if test "x$ac_cv_lib_bfd_bfd_init" = xyes; then : + # +- # Old binutils appear to need CONST defined to const +- # +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking if need to define CONST for bfd" >&5 +-$as_echo_n "checking if need to define CONST for bfd... " >&6; } +- if test "$cross_compiling" = yes; then : ++ # Old binutils appear to need CONST defined to const ++ # ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking need to define CONST for bfd" >&5 ++$as_echo_n "checking need to define CONST for bfd... " >&6; } ++ if test "$cross_compiling" = yes; then : + as_fn_error $? "cannot use bfd" "$LINENO" 5 + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#define IN_GCC +- #include +- int main() { symbol_info t; return 0;} ++ ++ #define IN_GCC ++ #include ++ ++int ++main () ++{ ++ ++ symbol_info t; ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -5785,10 +5470,20 @@ else + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#define CONST const +- #define IN_GCC +- #include +- int main() {symbol_info t; return 0;} ++ ++ #define CONST const ++ #define IN_GCC ++ #include ++ ++int ++main () ++{ ++ ++ symbol_info t; ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +@@ -5820,13 +5515,13 @@ done + $as_echo "#define HAVE_LIBBFD 1" >>confdefs.h + + +-# +-# BFD boolean syntax +-# ++ # ++ # BFD boolean syntax ++ # + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for useable bfd_boolean" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for useable bfd_boolean" >&5 + $as_echo_n "checking for useable bfd_boolean... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -5835,14 +5530,14 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #define IN_GCC +- #include +- bfd_boolean foo() {return FALSE;} ++ #define IN_GCC ++ #include ++ bfd_boolean foo() {return FALSE;} + + int + main () + { +-return 0; ++ + ; + return 0; + } +@@ -5862,13 +5557,13 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +-# +-# bfd_link_info.output_bfd minimal configure change check +-# +- +- ac_fn_c_check_member "$LINENO" "struct bfd_link_info" "output_bfd" "ac_cv_member_struct_bfd_link_info_output_bfd" " +- #include +- #include ++ # ++ # bfd_link_info.output_bfd minimal configure change check ++ # ++ ++ ac_fn_c_check_member "$LINENO" "struct bfd_link_info" "output_bfd" "ac_cv_member_struct_bfd_link_info_output_bfd" " ++ #include ++ #include + + " + if test "x$ac_cv_member_struct_bfd_link_info_output_bfd" = xyes; then : +@@ -5879,25 +5574,25 @@ fi + + + +-# +-# FIXME: Need to workaround mingw before this point -- CM +-# +- if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then +- echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c +- MP=`$CC -Wl,-M -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` +- rm -f foo.c foo +- if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then +- LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[j]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[j],j!=i ? "/" : "")}'`" +- else +- as_fn_error $? "cannot locate external libbfd.a" "$LINENO" 5 +- fi +- if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then +- LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[j]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[j],j!=i ? "/" : "")}'`" +- else +- as_fn_error $? "cannot locate external libiberty.a" "$LINENO" 5 +- fi +- BUILD_BFD=copy_bfd +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflate in -lz" >&5 ++ # ++ # FIXME: Need to workaround mingw before this point -- CM ++ # ++ if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then ++ echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c ++ MP=`$CC -Wl,-M -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` ++ rm -f foo.c foo ++ if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then ++ LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[j]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[j],j!=i ? \"/\" : \"\")}'`" ++ else ++ as_fn_error $? "cannot locate external libbfd.a" "$LINENO" 5 ++ fi ++ if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then ++ LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[j]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[k]=A[k+2];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[j],j!=i ? \"/\" : \"\")}'`" ++ else ++ as_fn_error $? "cannot locate external libiberty.a" "$LINENO" 5 ++ fi ++ BUILD_BFD=copy_bfd ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inflate in -lz" >&5 + $as_echo_n "checking for inflate in -lz... " >&6; } + if ${ac_cv_lib_z_inflate+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -5939,7 +5634,7 @@ else + as_fn_error $? "Need zlib for bfd linking" "$LINENO" 5 + fi + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlsym in -ldl" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlsym in -ldl" >&5 + $as_echo_n "checking for dlsym in -ldl... " >&6; } + if ${ac_cv_lib_dl_dlsym+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -5985,76 +5680,22 @@ fi + + + +- else +- TLIBS="$TLIBS -lbfd -liberty -ldl" +- fi ++ else ++ TLIBS="$TLIBS -lbfd -liberty -ldl" ++ fi + fi + +-if test "$enable_locbfd" = "yes" ; then +- +- # check for gettext. It is part of glibc, but others +- # need GNU gettext separately. +-# AC_CHECK_HEADERS(libintl.h, true, +-# AC_MSG_ERROR(libintl.h (gettext) not found)) +-# AC_SEARCH_LIBS(dgettext, intl, true, AC_MSG_ERROR(gettext library not found)) +- +- echo "#" +- echo "#" +- echo "# -------------------------" +- echo "# Subconfigure of LIBINTL" +- echo "#" +- echo "#" +- cd binutils/intl && chmod +x configure && ./configure --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of LIBINTL done" +- echo "# ------------------------------" +- echo "#" +- echo "#" +- echo "#" +- echo "# -------------------------" +- echo "# Subconfigure of LIBIBERTY" +- echo "#" +- echo "#" +- cd binutils/libiberty && chmod +x configure && ./configure --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of LIBIBERTY done" +- echo "# ------------------------------" +- echo "#" +- echo "#" +- echo "#" +- echo "# -------------------" +- echo "# Subconfigure of BFD" +- echo "#" +- echo "#" +- cd binutils/bfd && chmod +x configure && ./configure --with-included-gettext --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/bfd " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of BFD done" +- echo "# ------------------------" +- echo "#" +-# TLIBS="$TLIBS `pwd`/binutils/bfd/libbfd.a `pwd`/binutils/libiberty/libiberty.a" +- +-$as_echo "#define HAVE_LIBBFD 1" >>confdefs.h +- +- BUILD_BFD="h/bfd.h h/bfdlink.h h/ansidecl.h h/symcat.h" +- ++# Check whether --enable-xdr was given. ++if test "${enable_xdr+set}" = set; then : ++ enableval=$enable_xdr; + fi + + +-if test "$enable_xdr" = "yes" ; then +- ac_fn_c_check_func "$LINENO" "xdr_double" "ac_cv_func_xdr_double" ++if test "$enable_xdr" != "no" ; then ++ XDR_LIB="" ++ ac_fn_c_check_func "$LINENO" "xdr_double" "ac_cv_func_xdr_double" + if test "x$ac_cv_func_xdr_double" = xyes; then : +- +-$as_echo "#define HAVE_XDR 1" >>confdefs.h +- ++ XDR_LIB=" " + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -ltirpc" >&5 + $as_echo_n "checking for xdr_double in -ltirpc... " >&6; } +@@ -6093,10 +5734,7 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tirpc_xdr_double" >&5 + $as_echo "$ac_cv_lib_tirpc_xdr_double" >&6; } + if test "x$ac_cv_lib_tirpc_xdr_double" = xyes; then : +- +-$as_echo "#define HAVE_XDR 1" >>confdefs.h +- +- TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc" ++ XDR_LIB=tirpc + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lgssrpc" >&5 + $as_echo_n "checking for xdr_double in -lgssrpc... " >&6; } +@@ -6135,10 +5773,7 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gssrpc_xdr_double" >&5 + $as_echo "$ac_cv_lib_gssrpc_xdr_double" >&6; } + if test "x$ac_cv_lib_gssrpc_xdr_double" = xyes; then : +- +-$as_echo "#define HAVE_XDR 1" >>confdefs.h +- +- TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc" ++ XDR_LIB=gssrpc + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -lrpc" >&5 + $as_echo_n "checking for xdr_double in -lrpc... " >&6; } +@@ -6177,10 +5812,7 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_rpc_xdr_double" >&5 + $as_echo "$ac_cv_lib_rpc_xdr_double" >&6; } + if test "x$ac_cv_lib_rpc_xdr_double" = xyes; then : +- +-$as_echo "#define HAVE_XDR 1" >>confdefs.h +- +- TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc" ++ XDR_LIB=rpc + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xdr_double in -loncrpc" >&5 + $as_echo_n "checking for xdr_double in -loncrpc... " >&6; } +@@ -6219,10 +5851,7 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_oncrpc_xdr_double" >&5 + $as_echo "$ac_cv_lib_oncrpc_xdr_double" >&6; } + if test "x$ac_cv_lib_oncrpc_xdr_double" = xyes; then : +- +-$as_echo "#define HAVE_XDR 1" >>confdefs.h +- +- TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc" ++ XDR_LIB=oncrpc + fi + + fi +@@ -6233,6 +5862,16 @@ fi + + fi + ++ ++ if test "$XDR_LIB" != ""; then ++ ++$as_echo "#define HAVE_XDR 1" >>confdefs.h ++ ++ if test "$XDR_LIB" != " "; then ++ TLIBS="$TLIBS -l$XDR_LIB" ++ add_arg_to_tcflags -I/usr/include/$XDR_LIB ++ fi ++ fi + fi + + +@@ -6247,18 +5886,24 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- int main() { +- unsigned long u; +- long j; +- if (__builtin_clzl(0)!=sizeof(long)*8) +- return -1; +- for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) +- if (__builtin_clzl(u)!=j) +- return -1; +- return 0; +- } ++ #include ++ #include ++ ++int ++main () ++{ ++ ++ unsigned long u; ++ long j; ++ if (__builtin_clzl(0)!=sizeof(long)*8) ++ return -1; ++ for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) ++ if (__builtin_clzl(u)!=j) ++ return -1; ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +@@ -6286,18 +5931,24 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- int main() { +- unsigned long u; +- long j; +- if (__builtin_ctzl(0)!=sizeof(long)*8) +- return -1; +- for (u=1,j=0;j ++ #include ++ ++int ++main () ++{ ++ ++ unsigned long u; ++ long j; ++ if (__builtin_ctzl(0)!=sizeof(long)*8) ++ return -1; ++ for (u=1,j=0;j&5 +@@ -6316,13 +5967,13 @@ fi + + + case $use in +- sh4*) ;; #FIXME, these exceptions needed as of gcc 4.7 +- hppa*) ;; #FIXME +- powerpc*) ;; #FIXME +- alpha*) ;; #FIXME +- ia64*) ;; #FIXME +- *) +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking __builtin___clear_cache" >&5 ++ sh4*) ;; #FIXME, these exceptions needed as of gcc 4.7 ++ hppa*) ;; #FIXME ++ powerpc*) ;; #FIXME ++ alpha*) ;; #FIXME ++ ia64*) ;; #FIXME ++ *) ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking __builtin___clear_cache" >&5 + $as_echo_n "checking __builtin___clear_cache... " >&6; } + if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +@@ -6333,7 +5984,6 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- + int + main () + { +@@ -6349,7 +5999,7 @@ if ac_fn_c_try_run "$LINENO"; then : + + $as_echo "#define HAVE_BUILTIN_CLEAR_CACHE 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -6414,13 +6064,10 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- + int + main () + { + +- + /* Are we little or big endian? Adapted from Harbison&Steele. */ + union {long l;char c[sizeof(long)];} u; + u.l = 1; +@@ -6459,8 +6106,6 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- + int + main () + { +@@ -6494,8 +6139,8 @@ fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pagewidth" >&5 + $as_echo_n "checking for pagewidth... " >&6; } + case $use in +- mips*) min_pagewidth=14;; +- *) min_pagewidth=12;; ++ mips*) min_pagewidth=14;; ++ *) min_pagewidth=12;; + esac + if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +@@ -6506,23 +6151,21 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- #include +- #include +- #ifdef __CYGWIN__ +- #define getpagesize() 4096 +- #endif ++ #include ++ #include ++ #ifdef __CYGWIN__ ++ #define getpagesize() 4096 ++ #endif + + int + main () + { + +- size_t i=getpagesize(),j; +- FILE *fp=fopen("conftest1","w"); +- for (j=0;i>>=1;j++); +- j=j<$min_pagewidth ? $min_pagewidth : j; +- fprintf(fp,"%u",j); +- return 0; ++ size_t i=getpagesize(),j; ++ FILE *fp=fopen("conftest1","w"); ++ for (j=0;i>>=1;j++); ++ j=j<$min_pagewidth ? $min_pagewidth : j; ++ fprintf(fp,"%u",j); + + ; + return 0; +@@ -6557,27 +6200,27 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "./h/enum.h" +- #define OBJ_ALIGN +- #include "./h/type.h" +- #include "./h/lu.h" +- #include "./h/object.h" ++ #include ++ #define EXTER ++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "./h/enum.h" ++ #define OBJ_ALIGN ++ #include "./h/type.h" ++ #include "./h/lu.h" ++ #include "./h/object.h" + + int + main () + { + +- unsigned long i; +- FILE *fp=fopen("conftest1","w"); +- for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); +- if (!i) return -1; +- fprintf(fp,"%lu",i); +- fclose(fp); +- return 0; ++ unsigned long i; ++ FILE *fp=fopen("conftest1","w"); ++ for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); ++ if (!i) return -1; ++ fprintf(fp,"%lu",i); ++ fclose(fp); ++ return 0; + + ; + return 0; +@@ -6585,7 +6228,7 @@ main () + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + obj_align=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $obj_align" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $obj_align" >&5 + $as_echo "$obj_align" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -6615,8 +6258,8 @@ int + main () + { + +- char *v __attribute__ ((aligned ($obj_align))); +- return 0; ++ char *v __attribute__ ((aligned ($obj_align))); ++ + ; + return 0; + } +@@ -6653,8 +6296,8 @@ int + main () + { + +- extern int v() __attribute__ ((noreturn)); +- return 0; ++ extern int v() __attribute__ ((noreturn)); ++ + ; + return 0; + } +@@ -6679,68 +6322,43 @@ _ACEOF + { $as_echo "$as_me:${as_lineno-$LINENO}: checking sizeof struct contblock" >&5 + $as_echo_n "checking sizeof struct contblock... " >&6; } + +-# work around MSYS pwd result incompatibility +-if test "$use" = "mingw" ; then + if test "$cross_compiling" = yes; then : +- echo Cannot find sizeof struct contblock;exit 1 ++ as_fn_error $? "Cannot find sizeof struct contblock" "$LINENO" 5 + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "h/enum.h" +- #include "h/type.h" +- #include "h/lu.h" +- #include "h/object.h" +- int main(int argc,char **argv,char **envp) { +- FILE *f=fopen("conftest1","w"); +- fprintf(f,"%u",sizeof(struct contblock)); +- fclose(f); +- return 0; +- } +-_ACEOF +-if ac_fn_c_try_run "$LINENO"; then : +- sizeof_contblock=`cat conftest1` +-else +- echo Cannot find sizeof struct contblock;exit 1 +-fi +-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ +- conftest.$ac_objext conftest.beam conftest.$ac_ext +-fi + +-else +-if test "$cross_compiling" = yes; then : +- echo Cannot find sizeof struct contblock;exit 1 +-else +- cat confdefs.h - <<_ACEOF >conftest.$ac_ext +-/* end confdefs.h. */ +-#include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "`pwd`/h/enum.h" +- #include "`pwd`/h/type.h" +- #include "`pwd`/h/lu.h" +- #include "`pwd`/h/object.h" +- int main(int argc,char **argv,char **envp) { +- FILE *f=fopen("conftest1","w"); +- fprintf(f,"%u",sizeof(struct contblock)); +- fclose(f); +- return 0; +- } ++ #include ++ #define EXTER ++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "h/enum.h" ++ #include "h/type.h" ++ #include "h/lu.h" ++ #include "h/object.h" ++ ++int ++main () ++{ ++ ++ FILE *f=fopen("conftest1","w"); ++ fprintf(f,"%u",sizeof(struct contblock)); ++ fclose(f); ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + sizeof_contblock=`cat conftest1` + else +- echo Cannot find sizeof struct contblock;exit 1 ++ as_fn_error $? "Cannot find sizeof struct contblock" "$LINENO" 5 + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +-fi ++ + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_contblock" >&5 + $as_echo "$sizeof_contblock" >&6; } + +@@ -6758,19 +6376,25 @@ $as_echo "no: WARNING you must be able t + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #include +- int main() { ++ ++ #include ++ #include ++ ++int ++main () ++{ ++ + FILE *f; + if (!(f=fopen("conftest1","w"))) +- return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0; +- } ++ return -1; ++ fprintf(f,"%u",sbrk(0)); ++ ++ ; ++ return 0; ++} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- HAVE_SBRK=1 +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ HAVE_SBRK=1;{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no: WARNING you must be able to emulate sbrk: as on mingw or macosx" >&5 +@@ -6782,16 +6406,16 @@ fi + + + if test "$use" = "386-macosx" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: emulating sbrk for mac" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: emulating sbrk for mac" >&5 + $as_echo "emulating sbrk for mac" >&6; }; +- HAVE_SBRK=0 ++ HAVE_SBRK=0 + fi + + if test "$HAVE_SBRK" = "1" ; then + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_NO_RANDOMIZE constant" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_NO_RANDOMIZE constant" >&5 + $as_echo_n "checking for ADDR_NO_RANDOMIZE constant... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -6800,18 +6424,16 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- #include +- #include ++ #include ++ #include + + int + main () + { + +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_NO_RANDOMIZE); +- return 0; ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_NO_RANDOMIZE); + + ; + return 0; +@@ -6819,11 +6441,11 @@ main () + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + ADDR_NO_RANDOMIZE=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_NO_RANDOMIZE" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_NO_RANDOMIZE" >&5 + $as_echo "yes $ADDR_NO_RANDOMIZE" >&6; } + else + ADDR_NO_RANDOMIZE=0 +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no assuming 0x40000" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no assuming 0x40000" >&5 + $as_echo "no assuming 0x40000" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -6836,9 +6458,9 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_COMPAT_LAYOUT constant" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_COMPAT_LAYOUT constant" >&5 + $as_echo_n "checking for ADDR_COMPAT_LAYOUT constant... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -6847,18 +6469,16 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- #include +- #include ++ #include ++ #include + + int + main () + { + +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_COMPAT_LAYOUT); +- return 0; ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_COMPAT_LAYOUT); + + ; + return 0; +@@ -6866,11 +6486,11 @@ main () + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + ADDR_COMPAT_LAYOUT=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_COMPAT_LAYOUT" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_COMPAT_LAYOUT" >&5 + $as_echo "yes $ADDR_COMPAT_LAYOUT" >&6; } + else + ADDR_COMPAT_LAYOUT=0 +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -6883,9 +6503,9 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_LIMIT_3GB constant" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ADDR_LIMIT_3GB constant" >&5 + $as_echo_n "checking for ADDR_LIMIT_3GB constant... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -6894,18 +6514,16 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- #include +- #include ++ #include ++ #include + + int + main () + { + +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_LIMIT_3GB); +- return 0; ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_LIMIT_3GB); + + ; + return 0; +@@ -6913,11 +6531,11 @@ main () + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + ADDR_LIMIT_3GB=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_LIMIT_3GB" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes $ADDR_LIMIT_3GB" >&5 + $as_echo "yes $ADDR_LIMIT_3GB" >&6; } + else + ADDR_LIMIT_3GB=0 +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -6930,9 +6548,9 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for personality(ADDR_NO_RANDOMIZE) support" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for personality(ADDR_NO_RANDOMIZE) support" >&5 + $as_echo_n "checking for personality(ADDR_NO_RANDOMIZE) support... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -6941,12 +6559,13 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + ++ #include ++ #include ++ int main(int argc,char *argv[],char *envp[]) { ++ #include "h/unrandomize.h" ++ return 0; ++ } + +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- #include "h/unrandomize.h" +- return 0;} + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +@@ -6963,92 +6582,89 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking that sbrk is (now) non-random" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking that sbrk is (now) non-random" >&5 + $as_echo_n "checking that sbrk is (now) non-random... " >&6; } +- if test "$cross_compiling" = yes; then : +- SBRK=0 ++ SBRK=0 ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #include ++ ++ #include ++ #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0;} ++ if (!(f=fopen("conftest1","w"))) ++ return -1; ++ fprintf(f,"%u",sbrk(0)); ++ return 0; ++ } ++ + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + SBRK=`cat conftest1` +-else +- SBRK=0 + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- if test "$SBRK" = "0" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot trap sbrk" >&5 +-$as_echo "cannot trap sbrk" >&6; } +- exit 1 +- fi +- if test "$cross_compiling" = yes; then : +- SBRK1=0 ++ if test "$SBRK" = "0" ; then ++ as_fn_error $? "cannot trap sbrk" "$LINENO" 5 ++ fi ++ ++ SBRK1=0 ++ if test "$cross_compiling" = yes; then : ++ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 ++$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} ++as_fn_error $? "cannot run test program while cross compiling ++See \`config.log' for more details" "$LINENO" 5; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #include ++ ++ #include ++ #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0;} ++ fprintf(f,"%u",sbrk(0)); ++ return 0; ++ } ++ + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + SBRK1=`cat conftest1` +-else +- SBRK1=0 + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- if test "$SBRK1" = "0" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot trap sbrk" >&5 +-$as_echo "cannot trap sbrk" >&6; } +- exit 1 +- fi +- if test "$SBRK" = "$SBRK1" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ if test "$SBRK1" = "0" ; then ++ as_fn_error $? "cannot trap sbrk" "$LINENO" 5 ++ fi ++ if test "$SBRK" = "$SBRK1" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } +- else +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +- echo "Cannot build with randomized sbrk. Your options:" +- echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" +- echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" +- echo " - run sysctl kernel.randomize_va_space=0 before using gcl" +- exit 1 +- fi ++ echo "Cannot build with randomized sbrk. Your options:" ++ echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" ++ echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" ++ echo " - run sysctl kernel.randomize_va_space=0 before using gcl" ++ as_fn_error $? "exiting" "$LINENO" 5 ++ fi + fi +- +- +- +- +- +- +- +- +- +- +- + { $as_echo "$as_me:${as_lineno-$LINENO}: checking CSTACK_ADDRESS" >&5 + $as_echo_n "checking CSTACK_ADDRESS... " >&6; } + if test "$cross_compiling" = yes; then : +@@ -7060,34 +6676,35 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- void *v ; +- FILE *fp = fopen("conftest1","w"); +- unsigned long i,j; +- +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- j=1; +- j<<=$PAGEWIDTH; +- j<<=16; +- i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i-1); +- fclose(fp); +- return 0; +-} ++ #include ++ #include ++ void * ++ foo() { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++ unsigned long i,j; ++ ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++ if (foo()>i) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i-1); ++ fclose(fp); ++ return 0; ++ } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + cstack_address=`cat conftest1` +@@ -7117,35 +6734,36 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- void *v ; +- FILE *fp = fopen("conftest1","w"); +- unsigned long i,j; +- +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- j=1; +- j<<=$PAGEWIDTH; +- j<<=16; +- i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +- fprintf(fp,"%d",j); +- fclose(fp); +- return 0; +-} ++ #include ++ #include ++ void * ++ foo() { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++ unsigned long i,j; ++ ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++ if (foo()>i) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++ fprintf(fp,"%d",j); ++ fclose(fp); ++ return 0; ++ } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + cstack_bits=`cat conftest1` +@@ -7175,33 +6793,33 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- return (long)$cstack_address<0 ? 0 : -1; +-} ++ #include ++ #include ++ int ++ main(int argc,char **argv,char **envp) { ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ return (long)$cstack_address<0 ? 0 : -1; ++ } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } +- neg_cstack_address=1 ++ neg_cstack_address=1 + + $as_echo "#define NEG_CSTACK_ADDRESS 1" >>confdefs.h + + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +- neg_cstack_address=0 ++ neg_cstack_address=0 + fi + rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + + +- + { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding CSTACK_ALIGNMENT" >&5 + $as_echo_n "checking finding CSTACK_ALIGNMENT... " >&6; } + if test "$cross_compiling" = yes; then : +@@ -7213,23 +6831,23 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- void *b,*c; +- FILE *fp = fopen("conftest1","w"); +- long n; +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- b=alloca(sizeof(b)); +- c=alloca(sizeof(c)); +- n=b>c ? b-c : c-b; +- n=n>sizeof(c) ? n : 1; +- fprintf(fp,"%ld",n); +- fclose(fp); +- return 0; +-} ++ #include ++ #include ++ int main(int argc,char **argv,char **envp) { ++ void *b,*c; ++ FILE *fp = fopen("conftest1","w"); ++ long n; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ b=alloca(sizeof(b)); ++ c=alloca(sizeof(c)); ++ n=b>c ? b-c : c-b; ++ n=n>sizeof(c) ? n : 1; ++ fprintf(fp,"%ld",n); ++ fclose(fp); ++ return 0; ++ } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + cstack_alignment=`cat conftest1` +@@ -7259,24 +6877,25 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include +- void * +- foo(void) { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- char *b; +- FILE *fp = fopen("conftest1","w"); +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); +- fclose(fp); +- return 0; +-} ++ #include ++ #include ++ void * ++ foo(void) { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ char *b; ++ FILE *fp = fopen("conftest1","w"); ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); ++ fclose(fp); ++ return 0; ++ } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : + cstack_direction=`cat conftest1` +@@ -7295,62 +6914,74 @@ _ACEOF + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $cstack_direction" >&5 + $as_echo "$cstack_direction" >&6; } + ++# Check whether --enable-immfix was given. ++if test "${enable_immfix+set}" = set; then : ++ enableval=$enable_immfix; ++fi ++ ++ ++# Check whether --enable-fastimmfix was given. ++if test "${enable_fastimmfix+set}" = set; then : ++ enableval=$enable_fastimmfix; ++else ++ enable_fastimmfix=64 ++fi + + + + if test "$use" != "386-gnu" ; then #hurd can push .data below C stack, but sbrk(0) remains above, foiling unexec + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding default linker script" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding default linker script" >&5 + $as_echo_n "checking finding default linker script... " >&6; } +- touch unixport/gcl.script +- echo "int main() {return 0;}" >foo.c +- $CC -Wl,--verbose foo.c -o foo 2>&1 | \ +- $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script +- rm -rf foo.c foo ++ touch unixport/gcl.script ++ echo "int main() {return 0;}" >foo.c ++ $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ ++ $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script ++ rm -rf foo.c foo + +- if test "`cat gcl.script | wc -l`" != "0" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: got it" >&5 ++ if test "`cat gcl.script | wc -l`" != "0" ; then ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: got it" >&5 + $as_echo "got it" >&6; } +- { $as_echo "$as_me:${as_lineno-$LINENO}: trying to adjust text start" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: trying to adjust text start" >&5 + $as_echo "$as_me: trying to adjust text start" >&6;} +- cp gcl.script gcl.script.def ++ cp gcl.script gcl.script.def + +- n=-1; +- k=0; +- lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; +- max=0; +- min=$lim; +- while test $n -lt $lim ; do +- j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script +-# diff -u gcl.script.def gcl.script +- echo "int main() {return 0;}" >foo.c +- if ( $CC -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then +- if test $n -lt $min ; then min=$n; fi; +- if test $n -gt $max; then max=$n; fi; +- elif test $max -gt 0 ; then +- break; +- fi; +- n=`$AWK 'END {print n+1}' n=$n gcl.script ++ # diff -u gcl.script.def gcl.script ++ echo "int main() {return 0;}" >foo.c ++ if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++ if test $n -lt $min ; then min=$n; fi; ++ if test $n -gt $max; then max=$n; fi; ++ elif test $max -gt 0 ; then ++ break; ++ fi; ++ n=`$AWK 'END {print n+1}' n=$n &5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: min log text start $min" >&5 + $as_echo "$as_me: min log text start $min" >&6;} +- { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start $max" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start $max" >&5 + $as_echo "$as_me: max log text start $max" >&6;} + +- if test $neg_cstack_address -eq 1 ; then #FIXME test this +- if test $cstack_bits -lt $max ; then +- max=$cstack_bits; +- { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start reduced to $max considering c stack address" >&5 ++ if test $neg_cstack_address -eq 1 ; then #FIXME test this ++ if test $cstack_bits -lt $max ; then ++ max=$cstack_bits; ++ { $as_echo "$as_me:${as_lineno-$LINENO}: max log text start reduced to $max considering c stack address" >&5 + $as_echo "$as_me: max log text start reduced to $max considering c stack address" >&6;} +- fi +- fi ++ fi ++ fi + +- j=-1; +- low_shft=""; +- if test $min -le $max ; then +- if test $max -ge $enable_fastimmfix && test "$enable_immfix" = "yes" ; then ++ j=-1; ++ low_shft=""; ++ if test $min -le $max ; then ++ if test $max -ge $enable_fastimmfix && test "$enable_immfix" != "no" ; then + j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$max &5 +@@ -7360,9 +6991,9 @@ $as_echo "$as_me: raising log text to $j + { $as_echo "$as_me:${as_lineno-$LINENO}: lowering log text to $j to maximize data area" >&5 + $as_echo "$as_me: lowering log text to $j to maximize data area" >&6;} + fi +- fi ++ fi + +- if test "$low_shft" != "" ; then ++ if test "$low_shft" != "" ; then + + cat >>confdefs.h <<_ACEOF + #define LOW_SHFT $low_shft +@@ -7373,34 +7004,34 @@ cat >>confdefs.h <<_ACEOF + #define OBJNULL (object)0x$j + _ACEOF + +- else ++ else + + cat >>confdefs.h <<_ACEOF + #define OBJNULL NULL + _ACEOF + +- fi ++ fi + +-# echo $j; +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking our linker script" >&5 ++ # echo $j; ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking our linker script" >&5 + $as_echo_n "checking our linker script... " >&6; } +- if test "$j" -ne "-1" ; then ++ if test "$j" -ne "-1" ; then + cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[0-9]*","0x" j,$0);} {print}' j=$j >gcl.script + { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 + $as_echo "done" >&6; } + rm -f gcl.script.def + LDFLAGS="$LDFLAGS -Wl,-T gcl.script " + cp gcl.script unixport +- else +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: none found or not needed" >&5 ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none found or not needed" >&5 + $as_echo "none found or not needed" >&6; } +- rm -f gcl.script gcl.script.def +- fi +- rm -rf foo.c foo +- else +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 ++ rm -f gcl.script gcl.script.def ++ fi ++ rm -rf foo.c foo ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 + $as_echo "not found" >&6; } +- fi ++ fi + + else + +@@ -7412,19 +7043,6 @@ _ACEOF + + fi + +- +- +- +- +- +- +- +- +- +- +- +- +- + mem_top=0 + mem_range=0 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking mem top" >&5 +@@ -7438,30 +7056,30 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include ++ #include + + int + main () + { + +- void *v; +- unsigned long i,j,k,l,m; +- FILE *fp = fopen("conftest1","w"); +- +- for (i=2,k=1;i;k=i,i<<=1); +- l=$cstack_address; +- l=$cstack_direction==1 ? (l>=1,i|=j); +- if (j<(k>>3)) i=0; +- j=1; +- j<<=$PAGEWIDTH; +- j<<=4; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i); +- fclose(fp); +- return 0; ++ void *v; ++ unsigned long i,j,k,l,m; ++ FILE *fp = fopen("conftest1","w"); ++ ++ for (i=2,k=1;i;k=i,i<<=1); ++ l=$cstack_address; ++ l=$cstack_direction==1 ? (l>=1,i|=j); ++ if (j<(k>>3)) i=0; ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=4; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i); ++ fclose(fp); ++ return 0; + + ; + return 0; +@@ -7478,10 +7096,11 @@ fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_top" >&5 + $as_echo "$mem_top" >&6; } ++ + if test "$mem_top" != "0x0" ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding upper mem half range" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking finding upper mem half range" >&5 + $as_echo_n "checking finding upper mem half range... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -7490,19 +7109,19 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include ++ #include + + int + main () + { + +- unsigned long j; +- FILE *fp = fopen("conftest1","w"); ++ unsigned long j; ++ FILE *fp = fopen("conftest1","w"); + +- for (j=1;j && !(j& $mem_top);j<<=1); +- fprintf(fp,"0x%lx",j>>1); +- fclose(fp); +- return 0; ++ for (j=1;j && !(j& $mem_top);j<<=1); ++ fprintf(fp,"0x%lx",j>>1); ++ fclose(fp); ++ return 0; + + ; + return 0; +@@ -7517,9 +7136,9 @@ rm -f core *.core core.conftest.* gmon.o + conftest.$ac_objext conftest.beam conftest.$ac_ext + fi + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_range" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $mem_range" >&5 + $as_echo "$mem_range" >&6; } +- if test "$mem_range" != "0x0" ; then ++ if test "$mem_range" != "0x0" ; then + + cat >>confdefs.h <<_ACEOF + #define MEM_TOP $mem_top +@@ -7530,12 +7149,12 @@ cat >>confdefs.h <<_ACEOF + #define MEM_RANGE $mem_range + _ACEOF + +- fi ++ fi + fi + +-if test "$enable_immfix" = "yes" ; then +- if test "$mem_top" != "0x0" ; then +- if test "$mem_range" != "0x0" ; then ++if test "$enable_immfix" != "no" ; then ++ if test "$mem_top" != "0x0" ; then ++ if test "$mem_range" != "0x0" ; then + + cat >>confdefs.h <<_ACEOF + #define IM_FIX_BASE $mem_top +@@ -7546,24 +7165,10 @@ cat >>confdefs.h <<_ACEOF + #define IM_FIX_LIM $mem_range + _ACEOF + +- fi +- fi ++ fi ++ fi + fi + +- +- +- +-# On systems with execshield, brk is randomized. We need to catch +-# this and restore the traditional behavior here +- +- +- +- +- +- +- +- +- + { $as_echo "$as_me:${as_lineno-$LINENO}: checking sizeof long long int" >&5 + $as_echo_n "checking sizeof long long int... " >&6; } + if test "$cross_compiling" = yes; then : +@@ -7575,14 +7180,14 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include ++ #include + + int + main () + { + +- if (sizeof(long long int) == 2*sizeof(long)) return 0; +- return 1; ++ if (sizeof(long long int) == 2*sizeof(long)) return 0; ++ return 1; + + ; + return 0; +@@ -7604,7 +7209,6 @@ fi + + + +- + for ac_header in dirent.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "dirent.h" "ac_cv_header_dirent_h" "$ac_includes_default" +@@ -7614,21 +7218,21 @@ if test "x$ac_cv_header_dirent_h" = xyes + _ACEOF + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for d_type" >&5 + $as_echo_n "checking for d_type... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include ++ #include + + int + main () + { + +- struct dirent d; +- return d.d_type=0; ++ struct dirent d; ++ return d.d_type=0; + + ; + return 0; +@@ -7652,32 +7256,18 @@ fi + done + + +-# readline +-# Check whether --enable-readline was given. +-if test "${enable_readline+set}" = set; then : +- enableval=$enable_readline; +-else +- enable_readline="yes" +-fi +- +- + # ansi lisp ++SYSTEM=ansi_gcl ++CLSTANDARD=ANSI + # Check whether --enable-ansi was given. + if test "${enable_ansi+set}" = set; then : +- enableval=$enable_ansi; +-else +- enable_ansi="yes" ++ enableval=$enable_ansi; if test "$enable_ansi" = "no" ; then ++ SYSTEM=gcl ++ CLSTANDARD=CLtL1 ++ fi + fi + + +-if test "$enable_ansi" = "yes" ; then +- SYSTEM=ansi_gcl +- CLSTANDARD=ANSI +-else +- SYSTEM=gcl +- CLSTANDARD=CLtL1 +-fi +- + FLISP="saved_$SYSTEM" + + +@@ -7913,23 +7503,22 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- +- #include ++ #include + + int + main () + { + +- char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; +- int n, m; +- double f; +- char *endptr; +- FILE *fp=fopen("conftest1","w"); ++ char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; ++ int n, m; ++ double f; ++ char *endptr; ++ FILE *fp=fopen("conftest1","w"); + +- n=sscanf(s,"%lf%n",&f,&m); +- fprintf(fp,"%d",m); +- fclose(fp); +- return s[m]; ++ n=sscanf(s,"%lf%n",&f,&m); ++ fprintf(fp,"%d",m); ++ fclose(fp); ++ return s[m]; + + ; + return 0; +@@ -7940,7 +7529,7 @@ if ac_fn_c_try_run "$LINENO"; then : + $as_echo "none" >&6; } + else + buggy_maximum_sscanf_length=`cat conftest1` +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $buggy_maximum_sscanf_length" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $buggy_maximum_sscanf_length" >&5 + $as_echo "$buggy_maximum_sscanf_length" >&6; } + + cat >>confdefs.h <<_ACEOF +@@ -7955,8 +7544,10 @@ fi + + + EXTRA_LOBJS= +-if test "$try_japi" = "yes" ; then +- for ac_header in japi.h ++# Check whether --enable-japi was given. ++if test "${enable_japi+set}" = set; then : ++ enableval=$enable_japi; if test "$enable_japi" = "yes" ; then ++ for ac_header in japi.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "japi.h" "ac_cv_header_japi_h" "$ac_includes_default" + if test "x$ac_cv_header_japi_h" = xyes; then : +@@ -7965,14 +7556,16 @@ if test "x$ac_cv_header_japi_h" = xyes; + _ACEOF + $as_echo "#define HAVE_JAPI_H 1" >>confdefs.h + +- EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" +- LIBS="${LIBS} -ljapi -lwsock32" ++ EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" ++ LIBS="${LIBS} -ljapi -lwsock32" + fi + + done + ++ fi + fi + ++ + # Should really find a way to check for prototypes, but this + # basically works for now. CM + # +@@ -8057,15 +7650,15 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #define _GNU_SOURCE +- #include ++ #define _GNU_SOURCE ++ #include + + int + main () + { + +- float f; +- return isnormal(f) || !isnormal(f) ? 0 : 1; ++ float f; ++ return isnormal(f) || !isnormal(f) ? 0 : 1; + + ; + return 0; +@@ -8077,9 +7670,9 @@ $as_echo "#define HAVE_ISNORMAL 1" >>con + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fpclass in ieeefp.h" >&5 +-$as_echo_n "checking for fpclass in ieeefp.h... " >&6; } +- if test "$cross_compiling" = yes; then : ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fpclass of ieeefp.h" >&5 ++$as_echo_n "checking for fpclass of ieeefp.h... " >&6; } ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -8088,14 +7681,14 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include ++ #include + + int + main () + { + +- float f; +- return fpclass(f)>=FP_NZERO || fpclass(f)=FP_NZERO || fpclass(f)conftest.$ac_ext + /* end confdefs.h. */ + +- #define _GNU_SOURCE +- #include ++ #define _GNU_SOURCE ++ #include + + int + main () + { + +- float f; +- return isfinite(f) || !isfinite(f) ? 0 : 1; ++ float f; ++ return isfinite(f) || !isfinite(f) ? 0 : 1; + + ; + return 0; +@@ -8153,7 +7746,7 @@ $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for finite()" >&5 + $as_echo_n "checking for finite()... " >&6; } +- if test "$cross_compiling" = yes; then : ++ if test "$cross_compiling" = yes; then : + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 + $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + as_fn_error $? "cannot run test program while cross compiling +@@ -8162,15 +7755,15 @@ else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +- #include +- #include ++ #include ++ #include + + int + main () + { + +- float f; +- return finite(f) || !finite(f) ? 0 : 1; ++ float f; ++ return finite(f) || !finite(f) ? 0 : 1; + + ; + return 0; +@@ -8194,8 +7787,6 @@ rm -f core *.core core.conftest.* gmon.o + fi + + +- +- + #-------------------------------------------------------------------- + # Check for the existence of the -lsocket and -lnsl libraries. + # The order here is important, so that they end up in the right +@@ -8315,10 +7906,19 @@ fi + fi + + +-RL_OBJS="" +-RL_LIB="" +-if test "$enable_readline" = "yes" ; then +- for ac_header in readline/readline.h ++# readline ++# Check whether --enable-readline was given. ++if test "${enable_readline+set}" = set; then : ++ enableval=$enable_readline; ++fi ++ ++ ++if test "$use" = "mingw" ; then ++ enable_readline=no ++fi ++ ++if test "$enable_readline" != "no" ; then ++ for ac_header in readline/readline.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "readline/readline.h" "ac_cv_header_readline_readline_h" "$ac_includes_default" + if test "x$ac_cv_header_readline_readline_h" = xyes; then : +@@ -8365,12 +7965,8 @@ if test "x$ac_cv_lib_readline_rl_initial + + $as_echo "#define HAVE_READLINE 1" >>confdefs.h + +- TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware +- RL_OBJS=gcl_readline.o +-# Readline support now initialized automatically when compiled in, this lisp +-# object no longer needed -- 20040102 CM +-# RL_LIB=lsp/gcl_readline.o +- ++ TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware ++ RL_OBJS=gcl_readline.o + fi + + fi +@@ -8378,8 +7974,8 @@ fi + done + + +-# These tests discover differences between readline 4.1 and 4.3 +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rl_completion_matches in -lreadline" >&5 ++ # These tests discover differences between readline 4.1 and 4.3 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for rl_completion_matches in -lreadline" >&5 + $as_echo_n "checking for rl_completion_matches in -lreadline... " >&6; } + if ${ac_cv_lib_readline_rl_completion_matches+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -8429,34 +8025,37 @@ fi + + + ++# sockets ++ + { $as_echo "$as_me:${as_lineno-$LINENO}: checking For network code for nsocket.c" >&5 + $as_echo_n "checking For network code for nsocket.c... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ + +-#include +-#include +-#include +- +-#include +-#include +-#include +- +-/************* for the sockets ******************/ +-#include /* struct sockaddr, SOCK_STREAM, ... */ +-#ifndef NO_UNAME +-# include /* uname system call. */ +-#endif +-#include /* struct in_addr, struct sockaddr_in */ +-#include /* inet_ntoa() */ +-#include /* gethostbyname() */ ++ #include ++ #include ++ #include ++ ++ #include ++ #include ++ #include ++ ++ /************* for the sockets ******************/ ++ #include /* struct sockaddr, SOCK_STREAM, ... */ ++ #ifndef NO_UNAME ++ # include /* uname system call. */ ++ #endif ++ #include /* struct in_addr, struct sockaddr_in */ ++ #include /* inet_ntoa() */ ++ #include /* gethostbyname() */ + + int + main () + { +- connect(0,(struct sockaddr *)0,0); +- gethostbyname("jil"); +- socket(AF_INET, SOCK_STREAM, 0); ++ ++ connect(0,(struct sockaddr *)0,0); ++ gethostbyname("jil"); ++ socket(AF_INET, SOCK_STREAM, 0); + + ; + return 0; +@@ -8466,7 +8065,7 @@ if ac_fn_c_try_link "$LINENO"; then : + + $as_echo "#define HAVE_NSOCKET 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -8480,16 +8079,18 @@ rm -f core conftest.err conftest.$ac_obj + $as_echo_n "checking check for listen using fcntl... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +-#include ++ ++ #include ++ #include + + int + main () + { +-FILE *fp=fopen("configure.in","r"); +- int orig; +- orig = fcntl(fileno(fp), F_GETFL); +- if (! (orig & O_NONBLOCK )) return 0; ++ ++ FILE *fp=fopen("configure.in","r"); ++ int orig; ++ orig = fcntl(fileno(fp), F_GETFL); ++ if (! (orig & O_NONBLOCK )) return 0; + + ; + return 0; +@@ -8499,7 +8100,7 @@ if ac_fn_c_try_compile "$LINENO"; then : + + $as_echo "#define LISTEN_USE_FCNTL 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -8508,8 +8109,6 @@ fi + rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + + +- +- + ac_fn_c_check_func "$LINENO" "profil" "ac_cv_func_profil" + if test "x$ac_cv_func_profil" = xyes; then : + +@@ -8531,7 +8130,7 @@ fi + + + if test "$no_setenv" = "1" ; then +-ac_fn_c_check_func "$LINENO" "putenv" "ac_cv_func_putenv" ++ ac_fn_c_check_func "$LINENO" "putenv" "ac_cv_func_putenv" + if test "x$ac_cv_func_putenv" = xyes; then : + + $as_echo "#define HAVE_PUTENV 1" >>confdefs.h +@@ -8551,17 +8150,11 @@ fi + + gcl_ok=no + +- +- +- +- +- +-# if test "x$enable_machine" = "x" ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5 + $as_echo_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; } + + case $system in +- OSF*) ++ OSF*) + + $as_echo "#define USE_FIONBIO 1" >>confdefs.h + +@@ -8593,8 +8186,9 @@ esac + $as_echo_n "checking check for SV_ONSTACK... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +-int joe=SV_ONSTACK; ++ ++ #include ++ int joe=SV_ONSTACK; + + int + main () +@@ -8609,7 +8203,7 @@ if ac_fn_c_try_compile "$LINENO"; then : + $as_echo "#define HAVE_SV_ONSTACK 1" >>confdefs.h + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -8621,8 +8215,9 @@ rm -f core conftest.err conftest.$ac_obj + $as_echo_n "checking check for SIGSYS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +-int joe=SIGSYS; ++ ++ #include ++ int joe=SIGSYS; + + int + main () +@@ -8637,7 +8232,7 @@ if ac_fn_c_try_compile "$LINENO"; then : + $as_echo "#define HAVE_SIGSYS 1" >>confdefs.h + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -8650,8 +8245,9 @@ rm -f core conftest.err conftest.$ac_obj + $as_echo_n "checking check for SIGEMT... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +-int joe=SIGEMT; ++ ++ #include ++ int joe=SIGEMT; + + int + main () +@@ -8666,7 +8262,7 @@ if ac_fn_c_try_compile "$LINENO"; then : + $as_echo "#define HAVE_SIGEMT 1" >>confdefs.h + + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 + $as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +@@ -8705,7 +8301,7 @@ if test "x$ac_cv_header_dis_asm_h" = xye + #define HAVE_DIS_ASM_H 1 + _ACEOF + MLIBS=$LIBS +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for init_disassemble_info in -lopcodes" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for init_disassemble_info in -lopcodes" >&5 + $as_echo_n "checking for init_disassemble_info in -lopcodes... " >&6; } + if ${ac_cv_lib_opcodes_init_disassemble_info+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -8750,7 +8346,7 @@ _ACEOF + + fi + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 + $as_echo_n "checking for dlopen in -ldl... " >&6; } + if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -8788,7 +8384,7 @@ fi + $as_echo "$ac_cv_lib_dl_dlopen" >&6; } + if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + #opcodes changes too quickly to link directly +- for ac_func in print_insn_i386 ++ for ac_func in print_insn_i386 + do : + ac_fn_c_check_func "$LINENO" "print_insn_i386" "ac_cv_func_print_insn_i386" + if test "x$ac_cv_func_print_insn_i386" = xyes; then : +@@ -8807,7 +8403,7 @@ done + + + #if test $use = "386-linux" ; then +- for ac_header in asm/sigcontext.h ++for ac_header in asm/sigcontext.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "asm/sigcontext.h" "ac_cv_header_asm_sigcontext_h" "$ac_includes_default" + if test "x$ac_cv_header_asm_sigcontext_h" = xyes; then : +@@ -8819,7 +8415,7 @@ fi + + done + +- for ac_header in asm/signal.h ++for ac_header in asm/signal.h + do : + ac_fn_c_check_header_mongrel "$LINENO" "asm/signal.h" "ac_cv_header_asm_signal_h" "$ac_includes_default" + if test "x$ac_cv_header_asm_signal_h" = xyes; then : +@@ -8831,17 +8427,18 @@ fi + + done + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 ++{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 + $as_echo_n "checking for sigcontext...... " >&6; } +- cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include ++ ++ #include + + int + main () + { + +- struct sigcontext foo; ++ struct sigcontext foo; + + ; + return 0; +@@ -8849,38 +8446,31 @@ main () + _ACEOF + if ac_fn_c_try_compile "$LINENO"; then : + +- sigcontext_works=1; +- + $as_echo "#define SIGNAL_H_HAS_SIGCONTEXT 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext in signal.h" >&5 +-$as_echo "sigcontext in signal.h" >&6; } +- ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext of signal.h" >&5 ++$as_echo "sigcontext of signal.h" >&6; } + else +- sigcontext_works=0; +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext NOT in signal.h" >&5 +-$as_echo "sigcontext NOT in signal.h" >&6; } +- +-fi +-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +- if test "$sigcontext_works" = 0 ; then +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext NOT of signal.h" >&5 ++$as_echo "sigcontext NOT of signal.h" >&6; } ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sigcontext..." >&5 + $as_echo_n "checking for sigcontext...... " >&6; } +- cat confdefs.h - <<_ACEOF >conftest.$ac_ext ++ cat confdefs.h - <<_ACEOF >conftest.$ac_ext + /* end confdefs.h. */ +-#include +- #ifdef HAVE_ASM_SIGCONTEXT_H +- #include +- #endif +- #ifdef HAVE_ASM_SIGNAL_H +- #include +- #endif ++ ++ #include ++ #ifdef HAVE_ASM_SIGCONTEXT_H ++ #include ++ #endif ++ #ifdef HAVE_ASM_SIGNAL_H ++ #include ++ #endif + + int + main () + { + +- struct sigcontext foo; ++ struct sigcontext foo; + + ; + return 0; +@@ -8888,39 +8478,17 @@ main () + _ACEOF + if ac_fn_c_try_compile "$LINENO"; then : + +- + $as_echo "#define HAVE_SIGCONTEXT 1" >>confdefs.h + +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext in asm files" >&5 +-$as_echo "sigcontext in asm files" >&6; } +- ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: sigcontext asm files" >&5 ++$as_echo "sigcontext asm files" >&6; } + else +- +- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no sigcontext found" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no sigcontext found" >&5 + $as_echo "no sigcontext found" >&6; } +- + fi + rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +- +- +- fi +-# echo 'foo() {}' > conftest1.c +-# $CC -S conftest1.c +-# use_underscore=0 +-# if fgrep _foo conftest1.s ; then use_underscore=1 ; fi +-# if test $use_underscore = 0 ; then +-# MPI_FILE=mpi-386_no_under.o +-# else +-# MPI_FILE=mpi-386d.o +-# fi +-# AC_SUBST(MPI_FILE) +-# GCC=$CC +-# if test -x /usr/bin/i386-glibc20-linux-gcc ; then +-# GCC=/usr/bin/i386-glibc20-linux-gcc +-# fi +-# AC_SUBST(GCC) +- +-#fi ++fi ++rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + + # Extract the first word of "emacs", so it can be a program name with args. + set dummy emacs; ac_word=$2 +@@ -8980,11 +8548,11 @@ EOF + { $as_echo "$as_me:${as_lineno-$LINENO}: checking emacs site lisp directory" >&5 + $as_echo_n "checking emacs site lisp directory... " >&6; } + if [ "$EMACS_SITE_LISP" = "unknown" ] ; then +- if [ "$EMACS" != "" ] ; then +- EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` +- else +- EMACS_SITE_LISP="" +- fi ++ if [ "$EMACS" != "" ] ; then ++ EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++ else ++ EMACS_SITE_LISP="" ++ fi + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS_SITE_LISP" >&5 + $as_echo "$EMACS_SITE_LISP" >&6; } +@@ -9005,14 +8573,14 @@ EOF + { $as_echo "$as_me:${as_lineno-$LINENO}: checking emacs default.el" >&5 + $as_echo_n "checking emacs default.el... " >&6; } + if [ "$EMACS" != "" ] ; then +- EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++ EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` + else +- EMACS_DEFAULT_EL="" ++ EMACS_DEFAULT_EL="" + fi + if test -f "${EMACS_DEFAULT_EL}" ; then true;else +- if test -d $EMACS_SITE_LISP ; then +- EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el +- fi ++ if test -d $EMACS_SITE_LISP ; then ++ EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el ++ fi + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $EMACS_DEFAULT_EL" >&5 + $as_echo "$EMACS_DEFAULT_EL" >&6; } +@@ -9046,14 +8614,34 @@ fi + $as_echo "$INFO_DIR" >&6; } + + +-if test "$enable_tcltk" = "yes" ; then ++# Check whether --enable-tcltk was given. ++if test "${enable_tcltk+set}" = set; then : ++ enableval=$enable_tcltk; ++fi ++ ++# Check whether --enable-tkconfig was given. ++if test "${enable_tkconfig+set}" = set; then : ++ enableval=$enable_tkconfig; TK_CONFIG_PREFIX=$enableval ++else ++ TK_CONFIG_PREFIX=unknown ++fi ++ ++# Check whether --enable-tclconfig was given. ++if test "${enable_tclconfig+set}" = set; then : ++ enableval=$enable_tclconfig; TCL_CONFIG_PREFIX=$enableval ++else ++ TCL_CONFIG_PREFIX=unknown ++fi ++ ++ ++if test "$enable_tcltk" != "no" ; then + +- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tcl/tk" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tcl/tk" >&5 + $as_echo_n "checking for tcl/tk... " >&6; } + +- if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else ++ if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else + +- # Extract the first word of "tclsh", so it can be a program name with args. ++ # Extract the first word of "tclsh", so it can be a program name with args. + set dummy tclsh; ac_word=$2 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 + $as_echo_n "checking for $ac_word... " >&6; } +@@ -9092,76 +8680,76 @@ fi + + + +- if test "${TCLSH}" = "" ; then true ; else ++ if test "${TCLSH}" = "" ; then true ; else + +- rm -f conftest.tcl +- cat >> conftest.tcl <> conftest.tcl <&5 ++ TCL_VERSION_DOT_FREE=`echo ${TCL_VERSION} | tr -d .` ++ if test -f ${TK_CONFIG_PREFIX}/../bin/tcl${TCL_VERSION_DOT_FREE}.dll ; then ++ TCL_LIBS="-L${TK_CONFIG_PREFIX}/../bin -ltk${TCL_VERSION_DOT_FREE} -ltcl${TCL_VERSION_DOT_FREE}" ++ TCL_STUB_LIBS="-L${TK_CONFIG_PREFIX}/lib -ltkstub${TCL_VERSION_DOT_FREE} -ltclstub${TCL_VERSION_DOT_FREE}" ++ else ++ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -llieee" >&5 + $as_echo_n "checking for main in -llieee... " >&6; } + if ${ac_cv_lib_lieee_main+:} false; then : + $as_echo_n "(cached) " >&6 +@@ -9197,14 +8785,11 @@ else + have_ieee=0 + fi + +- if test "$have_ieee" = "0" ; then +- TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-lieee::g" ` +- fi +- if test "$have_dl" = "0" ; then +- TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-ldl::g"` +- fi +- TCL_STUB_LIBS="" +- fi ++ if test "$have_ieee" = "0" ; then ++ TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-lieee::g" ` ++ fi ++ TCL_STUB_LIBS="" ++ fi + + fi + +@@ -9229,16 +8814,18 @@ fi + + + if test -d "${TK_CONFIG_PREFIX}" ; then +-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}" >&5 +-$as_echo "using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}" >&6; } ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: using TK_VERSION=${TK_VERSION} of ${TK_CONFIG_PREFIX}" >&5 ++$as_echo "using TK_VERSION=${TK_VERSION} of ${TK_CONFIG_PREFIX}" >&6; } + else +-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 ++ { $as_echo "$as_me:${as_lineno-$LINENO}: result: not found" >&5 + $as_echo "not found" >&6; } + fi + +-NOTIFY=$enable_notify +- ++# Check whether --enable-notify was given. ++if test "${enable_notify+set}" = set; then : ++ enableval=$enable_notify; NOTIFY=$enable_notify + ++fi + + + +@@ -9477,42 +9064,17 @@ _ACEOF + fi + + +-# alloca +- +-# dlopen etc +-# idea make it so you do something dlopen(libX.so,RTLD_GLOBAL) +-# then dlload("foo.o") a lisp file can refer to things in libX.so +-# +- +-# what machine this is, and include then a machine specific hdr. +-# and machine specific defs. +- +-# check bzero, +- +-# check getcwd, getwd etc.. +- + ++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" + ++LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + +-# check socket stuff.. +- +-# getrlimit +- +-# fionread or block +- +-# redhat/cygnus released for some reason a buggy version of gcc, +-# which no one else released. Catch that here. +- +-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" +- +-LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $TLDFLAGS $LIBS $TLIBS" +- +-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS $PROCESSOR_FLAGS" ++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" + + # Work around bug with gcc on ppc -- CM +-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" ++NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" + +-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" ++CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" + + O3FLAGS=$TO3FLAGS + +@@ -9522,12 +9084,10 @@ O2FLAGS=$TO2FLAGS + + + +- +- + if test -f h/$use.defs ; then + + +- ac_config_files="$ac_config_files makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp" ++ ac_config_files="$ac_config_files makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp" + + cat >confcache <<\_ACEOF + # This file is a shell script that caches the results of configure +@@ -10804,13 +10364,13 @@ if test -n "$ac_unrecognized_opts" && te + $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} + fi + +- echo makedefc +- cat makedefc ++ echo makedefc ++ cat makedefc + +- echo add-defs1 $use +- CC=$CC ./add-defs1 $use ++ echo add-defs1 $use ++ CC=$CC ./add-defs1 $use + + else +- echo "Unable to guess machine type" +- echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs ++ echo "Unable to guess machine type" ++ echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs + fi +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -5,107 +5,6 @@ AC_CONFIG_HEADER(h/gclincl.h) + VERSION=`cat majvers`.`cat minvers` + AC_SUBST(VERSION) + +-# some parts of this configure script are taken from the tcl configure.in +- +-# +-# Arguments +-# +- +-dnl help="--enable-maxpage=XXXX will compile in a page table of size XXX (default ${default_maxpage})" +- +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl #include +-dnl ]],[[ +-dnl FILE *fp=fopen("conftest1","w"); +-dnl fprintf(fp,"%u",262144*( SIZEOF_LONG >>2)/(1<<($PAGEWIDTH-12))); +-dnl return 0;]])],[def_maxpage=`cat conftest1`],[def_maxpage=262144]) +- +-dnl AC_ARG_ENABLE(maxpage, +-dnl [ --enable-maxpage=XXXX will compile in a page table of size XXX +-dnl (eg '--enable-maxpage=64*1024' would produce +-dnl 64K pages allowing 256 MB if pages are 4K each)], +-dnl ,enable_maxpage=$def_maxpage) +- +-AC_ARG_ENABLE(widecons,[use a three word cons with simplified typing],[AC_DEFINE([WIDE_CONS],[1],[three word cons])]) +- +- +-AC_ARG_ENABLE(safecdr,[protect cdr from immfix and speed up type processing],,[enable_safecdr="no"]) +-if test "$enable_safecdr" = "yes" ; then +- AC_DEFINE([USE_SAFE_CDR],[1],[protect cdr from immfix and speed up type processing]) +-fi +-AC_ARG_ENABLE(safecdrdbg,[debug safecdr code],[AC_DEFINE([DEBUG_SAFE_CDR],[1],[debug safecdr code])]) +- +-AC_ARG_ENABLE([prelink],[--enable-prelink will insist that the produced images may be prelinked],[PRELINK_CHECK=t],[PRELINK_CHECK=]) +- +-AC_ARG_ENABLE([fastimmfix],[--enable-fastimmfix=XXXX will reject low immediate fixnums unless 1<&1 | fgrep ming > /dev/null ; +- then use=mingw +- else use=gnuwin95 ++ sh4*linux*) use=sh4-linux;; ++ *x86_64*linux*) use=amd64-linux;; ++ *x86_64*kfreebsd*) use=amd64-kfreebsd;; ++ *86*linux*) use=386-linux;; ++ *86*kfreebsd*) use=386-kfreebsd;; ++ *86*gnu*) use=386-gnu;; ++ m68k*linux*) use=m68k-linux;; ++ alpha*linux*) use=alpha-linux;; ++ mips*linux*) use=mips-linux;; ++ mipsel*linux*) use=mipsel-linux;; ++ sparc*linux*) use=sparc-linux;; ++ aarch64*linux*) use=aarch64-linux;; ++ arm*linux*) use=arm-linux;; ++ s390*linux*) use=s390-linux;; ++ ia64*linux*) use=ia64-linux;; ++ hppa*linux*) use=hppa-linux;; ++ powerpc*linux*) use=powerpc-linux;; ++ powerpc-*-darwin*) use=powerpc-macosx;; ++ *86*darwin*) use=386-macosx;; ++ i*mingw*|i*msys*) use=mingw;; ++ i*cygwin*) ++ if $CC -v 2>&1 | fgrep ming > /dev/null ; ++ then use=mingw ++ else use=gnuwin95 + fi;; +- +- *openbsd*) +- # 'ld -Z' means disable W^X +- TLDFLAGS="$TLDFLAGS -Z" +- use=FreeBSD;; +- ++ *openbsd*) use=FreeBSD;; ++ sparc-sun-solaris*) use=solaris;; ++ i?86-pc-solaris*) use=solaris-i386;; + esac + +-AC_SUBST(PROCESSOR_FLAGS) ++AC_ARG_ENABLE([machine],[ --enable-machine=XXXX will force the use of one of the definitions in h/XXXX.defs], ++ [echo enable_machine=$enableval ; use=$enableval]) + +-echo enable_machine=$enable_machine +-if test "x$enable_machine" != "x" ; then +- use=$enable_machine +-fi ++AC_MSG_RESULT([use=$use]) + + def_dlopen="no" + def_statsysbfd="no" + def_custreloc="yes" +-#def_statsysbfd="yes" +-#def_custreloc="no" +-def_locbfd="no" + def_oldgmp="no" + def_pic="no"; + def_static="no"; + def_debug="no"; + case $use in +- *kfreebsd) ++ *kfreebsd) + ln -snf linux.defs h/$use.defs;; +- *gnu) ++ *gnu) + ln -snf linux.defs h/$use.defs;; +- *linux) ++ *linux) + ln -snf linux.defs h/$use.defs; + case $use in +-# def_static -- Function descriptors are currently realized at runtime in a non-reproducible fashion +-# on these architectures -- CM +- powerpc*) +-# if test "$host_cpu" = "powerpc64" ; then def_dlopen="yes" ; def_custreloc="no" ; fi +- ;; +- ia64*) +- def_dlopen="yes" ; def_custreloc="no" ;; +- hppa*) +- def_pic="yes" ;; +-# def_dlopen="yes" ; def_custreloc="no" ; def_pic="yes" ;; ++ ia64*) ++ def_dlopen="yes" ; def_custreloc="no" ;; ++ hppa*) ++ def_pic="yes" ;; + esac;; + esac + +-AC_ARG_ENABLE(dlopen, +- [ --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images ] +- ,,enable_dlopen="$def_dlopen") +-AC_ARG_ENABLE(statsysbfd, +- [ --enable-statsysbfd uses a static sytem bfd library for loading and relocationing object files ] +- ,,enable_statsysbfd="$def_statsysbfd") +-AC_ARG_ENABLE(dynsysbfd, +- [ --enable-dynsysbfd uses a dynamic shared sytem bfd library for loading and relocationing object files ] +- ,,enable_dynsysbfd="no") +-#AC_ARG_ENABLE(locbfd, +-# [ --enable-locbfd uses a static bfd library built from this source tree for loading and relocationing object files ] +-# ,,enable_locbfd="$def_locbfd") +-AC_ARG_ENABLE(custreloc, +- [ --enable-custreloc uses custom gcl code if available for loading and relocationing object files ] +- ,,enable_custreloc="$def_custreloc") +-AC_ARG_ENABLE(debug, +- [ --enable-debug builds gcl with -g in CFLAGS to enable running under gdb ] +- ,,enable_debug="$def_debug") +-AC_ARG_ENABLE(gprof, +- [ --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof ] +- ,,enable_gprof="no") +-AC_ARG_ENABLE(static,[ --enable-static will link your GCL against static as opposed to shared system libraries ] , +- [enable_static=$enableval],[enable_static="$def_static"]) +-AC_ARG_ENABLE(pic, +- [ --enable-pic builds gcl with -fPIC in CFLAGS ] +- ,,enable_pic="$def_pic") +- +-AC_ARG_ENABLE(oldgmp, +- [ --enable-oldgmp will link against gmp2 instead of gmp3 ] +- ,,enable_oldgmp="$def_oldgmp") +- +-AC_ARG_ENABLE(dynsysgmp, +- [ --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source ] +- ,,enable_dynsysgmp="yes") ++AC_ARG_ENABLE([widecons],[ --enable-widecons will use a three word cons with simplified typing], ++ [if test "$enableval" = "yes" ; then AC_DEFINE([WIDE_CONS],[1],[three word cons]) fi]) ++ ++AC_ARG_ENABLE([safecdr],[ --enable-safecdr will protect cdr from immfix and speed up type processing], ++ [if test "$enableval" = "yes" ; then ++ AC_DEFINE([USE_SAFE_CDR],[1],[protect cdr from immfix and speed up type processing]) ++ AC_ARG_ENABLE([safecdrdbg],[ --enable-safecdrdbg will debug safecdr code], ++ [if test "$enableval" = "yes" ; then AC_DEFINE([DEBUG_SAFE_CDR],[1],[debug safecdr code]) fi]) ++ fi]) ++ ++AC_ARG_ENABLE([prelink],[ --enable-prelink will insist that the produced images may be prelinked], ++ [if test "$enable_prelink" = "yes" ; then PRELINK_CHECK=t; fi]) ++AC_SUBST(PRELINK_CHECK) ++ ++AC_ARG_ENABLE([vssize],[ --enable-vssize=XXXX will compile in a value stack of size XXX], ++ [AC_DEFINE_UNQUOTED(VSSIZE,$enableval,[value stack size])]) ++AC_ARG_ENABLE([bdssize],[ --enable-bdssize=XXXX will compile in a binding stack of size XXX], ++ [AC_DEFINE_UNQUOTED(BDSSIZE,$enableval,[binding stack size])]) ++AC_ARG_ENABLE([ihssize],[ --enable-ihssize=XXXX will compile in a invocation history stack of size XXX], ++ [AC_DEFINE_UNQUOTED(IHSSIZE,$enableval,[invocation history stack size])]) ++AC_ARG_ENABLE([frssize],[ --enable-frssize=XXXX will compile in a frame stack of size XXX], ++ [AC_DEFINE_UNQUOTED(FRSSIZE,$enableval,[frame stack size])]) ++ ++AC_ARG_ENABLE([infodir],[ --enable-infodir=XXXX will force the use of a INFO_DIR=XXXXX as place to look for info], ++ [INFO_DIR=$enableval],[INFO_DIR=$prefix/share/info]) ++INFO_DIR=`eval echo $INFO_DIR/` ++ ++AC_ARG_ENABLE([emacsdir],[ --enable-emacsdir=XXXX will manually specify the location for elisp files], ++ [EMACS_SITE_LISP=$enableval],[EMACS_SITE_LISP=$prefix/share/emacs/site-lisp]) ++EMACS_SITE_LISP=`eval echo $EMACS_SITE_LISP/` ++ ++AC_ARG_ENABLE([xgcl],[ --enable-xgcl=yes will compile in support for XGCL],,[enable_xgcl=yes]) + +-load_opt="0" ++AC_ARG_ENABLE([dlopen],[ --enable-dlopen uses dlopen for loading objects, which can then not be retained in saved images], ++ ,[enable_dlopen=$def_dlopen]) ++AC_ARG_ENABLE([statsysbfd],[ --enable-statsysbfd uses a static sytem bfd library for loading and relocationing object files], ++ ,[enable_statsysbfd=$def_statsysbfd]) ++AC_ARG_ENABLE([dynsysbfd],[ --enable-dynsysbfd uses a dynamic shared sytem bfd library for loading and relocationing object files], ++ ,[enable_dynsysbfd=no]) ++AC_ARG_ENABLE([custreloc],[ --enable-custreloc uses custom gcl code if available for loading and relocationing object files], ++ ,[enable_custreloc=$def_custreloc]) ++ ++AC_ARG_ENABLE([debug],[ --enable-debug builds gcl with -g in CFLAGS to enable running under gdb], ++ ,[enable_debug=$def_debug]) ++AC_ARG_ENABLE([static],[ --enable-static will link your GCL against static as opposed to shared system libraries], ++ ,[enable_static=$def_static]) ++AC_ARG_ENABLE([pic],[ --enable-pic builds gcl with -fPIC in CFLAGS],,[enable_pic=$def_pic]) ++ ++load_opt=0 + if test "$enable_dlopen" = "yes" ; then +- load_opt=1 ++ load_opt=1 + fi + if test "$enable_statsysbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ esac + fi + if test "$enable_dynsysbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- esac +-fi +-if test "$enable_locbfd" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- 3) load_opt=4;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ 2) load_opt=3;; ++ esac + fi + if test "$enable_custreloc" = "yes" ; then +- case $load_opt in +- 0) load_opt=1;; +- 1) load_opt=2;; +- 2) load_opt=3;; +- 3) load_opt=4;; +- 4) load_opt=5;; +- esac ++ case $load_opt in ++ 0) load_opt=1;; ++ 1) load_opt=2;; ++ 2) load_opt=3;; ++ 3) load_opt=4;; ++ 4) load_opt=5;; ++ esac + fi + + if test "$load_opt" != "1" ; then +- echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd locbfd=$enable_locbfd custreloc=$enable_custreloc" +- exit 1 ++ echo "Exactly one loader option must be chosen: dlopen=$enable_dlopen statsysbfd=$enable_statsysbfd dynsysbfd=$enable_dynsysbfd custreloc=$enable_custreloc" ++ AC_MSG_ERROR([loader option failure]) + fi + +-TLDFLAGS="" +-if test "$enable_static" = "yes" ; then +- TLDFLAGS="-static -Wl,-zmuldefs $TLDFLAGS"; #FIXME should be in unixport/makefile +- AC_DEFINE(STATIC_LINKING,1,[staticly linked images]) +-fi +-case $use in +- *gnuwin*) +- TLDFLAGS="$TLDFLAGS -Wl,--stack,8000000";; +-esac +- +-## finally warn if we did not find a recognized machine.s +-## +-#if test "$use" = "unknown" ; then +-#types=`echo h/*.defs` | sed -e "s:h/::g" -e "s:\.defs:g"` +-#echo got canonical=$canonical, but was not recognized. +-#echo Unable to guess type to use. Try one of +-#exit(1) +-#fi +- +-AC_MSG_RESULT([use=$use]) +- + + # + # System programs +@@ -462,221 +170,250 @@ AC_MSG_RESULT([use=$use]) + # We set the default CFLAGS below, and don't want the autoconf default + # CM 20040106 + if test "$CFLAGS" = "" ; then +- CFLAGS=" " ++ CFLAGS=" " + fi + if test "$LDFLAGS" = "" ; then +- LDFLAGS=" " ++ LDFLAGS=" " + fi + + AC_PROG_CC + AC_PROG_CPP + AC_SUBST(CC) ++GCL_CC=`basename $CC` ++if echo $GCL_CC |grep gcc |grep -q win; then ++ GCL_CC=gcc ++fi ++AC_SUBST(GCL_CC) + ++add_arg_to_tcflags() { ++ ++ local i=1 ++ AC_MSG_CHECKING([for CFLAG $1]) ++ CFLAGS_ORI=$CFLAGS ++ CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[]],[[]])], ++ [TCFLAGS="$TCFLAGS $1";AC_MSG_RESULT([yes]);i=0], ++ [AC_MSG_RESULT([no])], ++ [AC_MSG_RESULT([no])]) ++ CFLAGS=$CFLAGS_ORI ++ return $i ++ ++} + +-# can only test for numbers -- CM +-# if test "${GCC}" -eq "yes" ; then +-#if [[ "${GCC}" = "yes" ]] ; then +-# Allog for environment variable overrides on compiler selection -- CM +-#GCC=$CC +-#else +-#GCC="" +-#fi +-# subst GCC not only under 386-linux, but where available -- CM +- +-TCFLAGS="-fsigned-char -fno-builtin-malloc -fno-builtin-free" +- +-if test "$GCC" = "yes" ; then +- +- TCFLAGS="$TCFLAGS -Wall" +- +- AC_MSG_CHECKING([for clang]) +- AC_RUN_IFELSE([ +- AC_LANG_SOURCE([[ +- int main() { +- return +- #ifdef __clang__ +- 0 +- #else +- 1 +- #endif +- ;}]])], +- [AC_MSG_RESULT([yes]) +- clang="yes" +- TCFLAGS="$TCFLAGS -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign" +- AC_DEFINE([CLANG],[1],[running clang compiler])], +- [AC_MSG_RESULT([no]) +- #FIXME -Wno-unused-but-set-variable when time +- TMPF=-Wno-unused-but-set-variable +- AC_MSG_CHECKING([for CFLAG $TMPF]) +- CFLAGS_ORI=$CFLAGS +- CFLAGS="$CFLAGS $TMPF" +- AC_TRY_RUN([int main() {return 0;}],TCFLAGS="$TCFLAGS $TMPF";AC_MSG_RESULT(yes),AC_MSG_RESULT(no),AC_MSG_RESULT(no)) +- CFLAGS=$CFLAGS_ORI]) +-fi ++assert_arg_to_tcflags() { ++ if ! add_arg_to_tcflags $1 ; then AC_MSG_RESULT([cannot add $1 to CFLAGS]); exit 1 ; fi ++ return 0 ++} + +-if test "$GCC" = "yes" ; then +- TCFLAGS="$TCFLAGS -pipe" +- case $use in +- *mingw*) +-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +-# echo " It is otherwise needed for the Unexec stuff to work." +-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; +- *gnuwin*) +-# echo "WARNING: Remove -fno-zero-initialized-in-bss from makedefs if gcc less than 3.3.1." +-# echo " It is otherwise needed for the Unexec stuff to work." +-# if test "$enable_debug" = "yes" ; then TCFLAGS="$TCFLAGS -gstabs" ; fi +- TCFLAGS="$TCFLAGS -fno-zero-initialized-in-bss -mms-bitfields";; +- esac +-fi +-#if test -f /proc/sys/kernel/exec-shield ; then +-# exec_stat=`cat /proc/sys/kernel/exec-shield` +-# if test "$exec_stat" != "0" ; then +-# # CFLAGS here to hopefully cover the DBEGIN routine below +-# CFLAGS="$CFLAGS -Wa,--execstack" +-# fi +-#fi ++add_args_to_tcflags() { ++ ++ while test "$#" -ge 1 ; do ++ add_arg_to_tcflags $1 ++ shift ++ done ++} ++ ++add_arg_to_tldflags() { ++ ++ local i=1 ++ AC_MSG_CHECKING([for LDFLAG $1]) ++ LDFLAGS_ORI=$LDFLAGS ++ LDFLAGS="$LDFLAGS -Werror $1" ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[]],[[]])], ++ [TLDFLAGS="$TLDFLAGS $1";AC_MSG_RESULT([yes]);i=0], ++ [AC_MSG_RESULT([no])], ++ [AC_MSG_RESULT([no])]) ++ LDFLAGS=$LDFLAGS_ORI ++ return $i ++ ++} ++ ++assert_arg_to_tldflags() { ++ if ! add_arg_to_tldflags $1 ; then AC_MSG_RESULT([cannot add $1 to LDFLAGS]); exit 1 ; fi ++ return 0 ++} ++ ++add_args_to_tldflags() { ++ ++ while test "$#" -ge 1 ; do ++ add_arg_to_tldflags $1 ++ shift ++ done ++} ++ ++remove_arg_from_ldflags() { ++ ++ NEW_LDFLAGS="" ++ for i in $LDFLAGS; do ++ if ! test "$i" = "$1" ; then ++ NEW_LDFLAGS="$NEW_LDFLAGS $i" ++ else ++ AC_MSG_RESULT([removing $1 from LDFLAGS]) ++ fi ++ done ++ LDFLAGS=$NEW_LDFLAGS ++ ++ return 0 ++ ++} ++ ++TCFLAGS="" ++add_args_to_tcflags -fsigned-char -pipe \ ++ -fno-builtin-malloc -fno-builtin-free \ ++ -fno-PIE -fno-pie -fno-PIC -fno-pic \ ++ -Wall \ ++ -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ ++ -Wno-unused-but-set-variable -Wno-misleading-indentation ++ ++TLDFLAGS="" ++add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++ ++AC_MSG_CHECKING([for clang]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[ ++ #ifdef __clang__ ++ #define RET 0 ++ #else ++ #define RET 1 ++ #endif ++ ]], ++ [[ ++ return RET; ++ ]])], ++ [AC_MSG_RESULT([yes]) ++ clang="yes" ++ remove_arg_from_ldflags -pie ++ AC_DEFINE([CLANG],[1],[running clang compiler])], ++ [AC_MSG_RESULT([no])]) ++ ++case $use in ++ *mingw*) ++ assert_arg_to_tcflags -fno-zero-initialized-in-bss ++ assert_arg_to_tcflags -mms-bitfields;; ++ *gnuwin*) ++ assert_arg_to_tcflags -fno-zero-initialized-in-bss ++ assert_arg_to_tcflags -mms-bitfields ++ assert_arg_to_tldflags -Wl,--stack,8000000;; ++ 386-macosx) ++ assert_arg_to_tldflags -Wl,-no_pie ++ if test "$build_cpu" = "x86_64" ; then ++ assert_arg_to_tcflags -m64 ++ assert_arg_to_tldflags -m64 ++ assert_arg_to_tldflags -Wl,-headerpad,72 ++ else ++ assert_arg_to_tcflags -m32 ++ assert_arg_to_tldflags -m32 ++ assert_arg_to_tldflags -Wl,-headerpad,56 ++ fi;; ++ FreeBSD) assert_arg_to_tldflags -Z;; ++esac ++ ++if test "$enable_static" = "yes" ; then ++ assert_arg_to_tldflags -static ++ assert_arg_to_tldflags -Wl,-zmuldefs ++ AC_DEFINE(STATIC_LINKING,1,[staticly linked images]) ++fi + + TO3FLAGS="" + TO2FLAGS="" + +-#TFPFLAG="-fomit-frame-pointer" +-# FIXME -- remove when mingw compiler issues are fixed + case "$use" in +- *mingw*) ++ *mingw*) + TFPFLAG="";; +- m68k*)#FIXME gcc 4.x bug workaround ++ m68k*)#FIXME gcc 4.x bug workaround + TFPFLAG="";; +- *) ++ *) + TFPFLAG="-fomit-frame-pointer";; + esac + + AC_CHECK_PROGS(AWK,[gawk nawk awk]) + +-# Work around system/gprof mips/hppa hang +-AC_MSG_CHECKING([working gprof]) +-old_enable_gprof=$enable_gprof +-case $use in +- powerpc*) if test "$host_cpu" = "powerpc64le" ; then enable_gprof="no"; fi;; +- sh4*) enable_gprof="no";; +- ia64*) enable_gprof="no";; +-# mips*) enable_gprof="no";; +- hppa*) enable_gprof="no";; +- arm*) enable_gprof="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible +- *gnu) enable_gprof="no";; +-esac +-if test "$enable_gprof" = "$old_enable_gprof" ; then +- AC_MSG_RESULT([ok]) +-else +- AC_MSG_RESULT([disabled]) +-fi +- +-if test "$enable_gprof" = "yes" ; then +- AC_MSG_CHECKING(for text start) +- echo 'int main () {return(0);}' >foo.c +- $CC foo.c -o foo +- GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc +- rm -f foo.c foo +- if test "$GCL_GPROF_START" != "" ; then +- AC_MSG_RESULT($GCL_GPROF_START) +- AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) +- case "$use" in +- arm*) +- #FIXME report and remove this when done +- AC_MSG_RESULT(Reducing optimization on profiling arm build to workaround gcc bug) +- enable_debug=yes;; +- esac +- TCFLAGS="$TCFLAGS -pg"; +- case $use in +- s390*) ;; # relocation truncation bug in gcc +- *) TLIBS="$TLIBS -pg";; +- esac +- TFPFLAG="" +- AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) +- else +- enable_gprof="no"; +- fi +-fi +- +-if $CC -v 2>&1 | tail -1 | grep "gcc version 4.6.1" >/dev/null ; then +- case "$use" in +- arm*) +- #FIXME report and remove this when done +- AC_MSG_RESULT(Reducing optimization on arm build to workaround gcc 4.6 bug) +- enable_debug=yes;; +- esac +-fi +- ++AC_ARG_ENABLE([gprof],[ --enable-gprof builds gcl with -pg in CFLAGS to enable profiling with gprof], ++ [if test "$enableval" = "yes" ; then ++ AC_MSG_CHECKING([working gprof]) ++ case $use in ++ powerpc*) if test "$host_cpu" = "powerpc64le" ; then enableval="no"; fi;; ++ sh4*) enableval="no";; ++ ia64*) enableval="no";; ++ hppa*) enableval="no";; ++ arm*) enableval="no";;#FIXME mcount compiled as a 24/22 bit reloc even with -mlong-calls, marginally accessible ++ *gnu) enableval="no";; ++ esac ++ if test "$enableval" != "yes" ; then ++ AC_MSG_RESULT([disabled]) ++ else ++ AC_MSG_RESULT([ok]) ++ AC_MSG_CHECKING([for text start]) ++ echo 'int main () {return(0);}' >foo.c ++ $CC foo.c -o foo ++ GCL_GPROF_START=`nm foo | $AWK '/ *[[TD]] *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc ++ rm -f foo.c foo ++ if test "$GCL_GPROF_START" != "" ; then ++ AC_MSG_RESULT($GCL_GPROF_START) ++ AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) ++ assert_arg_to_tcflags -pg ++ case $use in ++ s390*) ;; # relocation truncation bug in gcc ++ *) TLIBS="$TLIBS -pg";; ++ esac ++ TFPFLAG="" ++ AC_DEFINE(GCL_GPROF,1,[use gprof profiling]) ++ fi ++ fi ++ fi]) + + if test "$enable_debug" = "yes" ; then +- TCFLAGS="$TCFLAGS -g" +- # for subconfigurations +- CFLAGS="$CFLAGS -g" ++ assert_arg_to_tcflags -g ++ # for subconfigurations ++ CFLAGS="$CFLAGS -g" + else +- TO3FLAGS="-O3 $TFPFLAG" +- TO2FLAGS="-O" ++ TO3FLAGS="-O3 $TFPFLAG" ++ TO2FLAGS="-O" + fi + + # gcc on ppc cannot compile our new_init.c with full opts --CM + TONIFLAGS="" + case $use in +- powerpc*macosx) +- TCFLAGS="$TCFLAGS -mlongcall";; +- *linux) ++ powerpc*macosx) assert_arg_to_tcflags -mlongcall;; ++ *linux) + case $use in +-# amd64*) # stack-boundary option does not work +-# TCFLAGS="$TCFLAGS -m64 -mpreferred-stack-boundary=8";; +- alpha*) +- TCFLAGS="$TCFLAGS -mieee" +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 +- ;; +-# m68k*) +-# TCFLAGS="$TCFLAGS -ffloat-store";; +- aarch64*) +- TLIBS="$TLIBS -lgcc_s";; +- hppa*) +- TCFLAGS="$TCFLAGS -mlong-calls " +- TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 +-# TCFLAGS="$TCFLAGS -ffunction-sections" +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O $TFPFLAG" ; fi +-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi +- ;; +- mips*) +- case $canonical in +- mips64*linux*) +- TLIBS="$TLIBS -Wl,-z -Wl,now";; +- esac +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2 +- ;; +- ia64*) +- if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 +- ;; +- arm*) +- TCFLAGS="$TCFLAGS -mlong-calls -fdollars-in-identifiers -g " +-# if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.6.2 +-# if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi +- ;; +- powerpc*) +- TCFLAGS="$TCFLAGS -mlongcall" +- ;; +-# if $CC -v 2>&1 | grep -q "gcc version 3.2" ; then +-# echo Reducing optimization for buggy gcc-3.2 +-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +-# fi; +-# echo Probing for longcall +-# if ! $CC -v 2>&1 | $AWK '/^gcc version / {split($3,A,".");if (A[[1]]+0>3 || (A[[1]]+0>=3 && A[[2]]+0>=3)) exit 1;}'; then +-# echo Enabling longcall on gcc 3.3 or later +-# TCFLAGS="$TCFLAGS -mlongcall" +-# echo Reducing optimization for buggy gcc 3.3 or later +-# if test "$enable_debug" != "yes" ; then TONIFLAGS="-O $TFPFLAG" ; fi +-# fi;; ++ alpha*) ++ assert_arg_to_tcflags -mieee ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ aarch64*) ++ TLIBS="$TLIBS -lgcc_s";; ++ hppa*) ++ assert_arg_to_tcflags -mlong-calls ++ TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ mips*) ++ case $canonical in ++ mips64*linux*) ++ assert_arg_to_tldflags -Wl,-z,now;; ++ esac ++ ;; ++ ia64*) ++ if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 ++ ;; ++ arm*) ++ assert_arg_to_tcflags -mlong-calls ++ assert_arg_to_tcflags -fdollars-in-identifiers ++ assert_arg_to_tcflags -g #? ++ ;; ++ powerpc*) ++ assert_arg_to_tcflags -mlongcall ++ ;; + esac;; + esac + if test "$enable_pic" = "yes" ; then +- TCFLAGS="$TCFLAGS -fPIC" ++ assert_arg_to_tcflags -fPIC + fi + ++ + FDEBUG=`echo $CFLAGS | tr ' ' '\012' |grep "^\-g$"|tr '\012' ' '` + #CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-g$"` + FOMITF=`echo $CFLAGS | tr ' ' '\012' |grep "^\-fomit-frame-pointer$"|tr '\012' ' '` +@@ -693,27 +430,27 @@ FOOPT0=`echo $CFLAGS | tr ' ' '\012' |gr + CFLAGS=`echo $CFLAGS | tr ' ' '\012' |grep -v "^\-O0$"|tr '\012' ' '` + + if test "$FOOPT0" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` +-else +-if test "$FOOPT1" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[2-3]],-O1,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[2-3]],-O1,g'` ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[123 ]],-O0 ,g' | sed 's,\-O$,-O0 ,g'` + else +-if test "$FOOPT2" != "" ; then +- TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` +- TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` +-fi +-fi ++ if test "$FOOPT1" != "" ; then ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-O[[2-3]],-O1,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-O[[2-3]],-O1,g'` ++ else ++ if test "$FOOPT2" != "" ; then ++ TO3FLAGS=`echo "$TO3FLAGS" | sed 's,\-O3,-O2,g'` ++ TO2FLAGS=`echo "$TO2FLAGS" | sed 's,\-O3,-O2,g'` ++ fi ++ fi + fi + + if test "$FDEBUG" != "" ; then +- TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` +- TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ TO3FLAGS=`echo $TO3FLAGS | sed 's,\-fomit-frame-pointer,,g'` ++ TO2FLAGS=`echo $TO2FLAGS | sed 's,\-fomit-frame-pointer,,g'` + fi + + if test "$FOMITF" != "" ; then +- TO3FLAGS="$TO3FLAGS $FOMITF" ++ TO3FLAGS="$TO3FLAGS $FOMITF" + fi + + # Step 1: set the variable "system" to hold the name and version number +@@ -731,12 +468,12 @@ if test -f /usr/lib/NextStep/software_ve + else + system=`uname -s`-`uname -r` + if test "$?" -ne 0 ; then +- AC_MSG_RESULT([unknown (can't find uname command)]) ++ AC_MSG_RESULT([unknown (cannot find uname command)]) + system=unknown + else + # Special check for weird MP-RAS system (uname returns weird + # results, and the version is kept in special file). +- ++ + if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then + system="MP-RAS-`${AWK} '{print $3}' '/etc/.relid'`" + fi +@@ -748,156 +485,130 @@ else + fi + + case $use in +- *macosx) ++ *macosx) + AC_CHECK_HEADERS(malloc/malloc.h,,[AC_MSG_ERROR([need malloc.h on macosx])]) + AC_CHECK_MEMBER([struct _malloc_zone_t.memalign], +- AC_DEFINE(HAVE_MALLOC_ZONE_MEMALIGN,1,[memalign element present]), [], +- [ +- #include +- ]) ++ AC_DEFINE(HAVE_MALLOC_ZONE_MEMALIGN,1,[memalign element present]), [], ++ [ ++ #include ++ ]) + AC_SUBST(HAVE_MALLOC_ZONE_MEMALIGN) + ;; + esac + +- +-AC_CHECK_HEADERS(setjmp.h, +- AC_MSG_CHECKING([sizeof jmp_buf]) +- AC_RUN_IFELSE([ +- AC_LANG_SOURCE([[ +- #include +- #include +- int main() { +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%lu\n",sizeof(jmp_buf)); +- fclose(fp); +- return 0; +- }]])], +- [sizeof_jmp_buf=`cat conftest1` +- AC_MSG_RESULT($sizeof_jmp_buf) +- AC_DEFINE_UNQUOTED(SIZEOF_JMP_BUF,$sizeof_jmp_buf,[sizeof jmp_buf])], +- [AC_MSG_RESULT(no)])) ++AC_CHECK_HEADERS( ++ [setjmp.h], ++ [AC_MSG_CHECKING([sizeof jmp_buf]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%lu\n",sizeof(jmp_buf)); ++ fclose(fp); ++ ]])], ++ [sizeof_jmp_buf=`cat conftest1` ++ AC_MSG_RESULT($sizeof_jmp_buf) ++ AC_DEFINE_UNQUOTED(SIZEOF_JMP_BUF,$sizeof_jmp_buf,[sizeof jmp_buf])], ++ [AC_MSG_RESULT([no])])]) + + # sysconf ++AC_CHECK_HEADERS( ++ [unistd.h], ++ [AC_CHECK_LIB( ++ [c],[sysconf], ++ [AC_MSG_CHECKING([_SC_CLK_TCK]) ++ hz=0 ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); ++ fclose(fp); ++ ]], ++ [hz=`cat conftest1` ++ AC_DEFINE_UNQUOTED(HZ,$hz,[time system constant])])]) ++ AC_MSG_RESULT($hz)])]) + +-AC_CHECK_HEADERS(unistd.h, +- AC_CHECK_LIB(c,sysconf, +- AC_MSG_CHECKING(_SC_CLK_TCK) +- AC_TRY_RUN([#include +- #include +- int +- main() { +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%lu\n",sysconf(_SC_CLK_TCK)); +- fclose(fp); +- return 0; +- }], +- hz=`cat conftest1` +- AC_DEFINE_UNQUOTED(HZ,$hz,[time system constant]) +- ,hz=0,hz=0) +- [AC_MSG_RESULT($hz)] +- dnl AC_MSG_CHECKING(_SC_PHYS_PAGES) +- dnl AC_RUN_IFELSE([ +- dnl AC_LANG_SOURCE([[ +- dnl #include +- dnl #include +- dnl int main() { +- dnl FILE *fp=fopen("conftest1","w"); +- dnl fprintf(fp,"%lu\n",sysconf(_SC_PHYS_PAGES)); +- dnl fclose(fp); +- dnl return 0; +- dnl }]])], +- dnl [phys=`cat conftest1` +- dnl AC_MSG_RESULT($phys) +- dnl AC_DEFINE(HAVE_SYSCONF_PHYS_PAGES,$phys,[probe runtime phys pages for gc performance])], +- dnl [AC_MSG_RESULT(no)]) +- )) +- +- +-#MY_SUBDIRS= +- +-# +-# GMP +-# + + rm -f makedefsafter + +-MP_INCLUDE="" +-if test $use_gmp = yes ; then ++AC_ARG_ENABLE([dynsysgmp], ++ [ --enable-dynsysgmp will link against the system libgmp3 overriding certain functions with patched versions from the local source]) + +- PATCHED_SYMBOLS="" +- if test "$enable_dynsysgmp" = "yes" ; then +- AC_CHECK_HEADERS(gmp.h, +- AC_CHECK_LIB(gmp,__gmpz_init, +- AC_MSG_CHECKING("for external gmp version") +- AC_TRY_RUN([#include +- int main() { +- #if __GNU_MP_VERSION > 3 +- return 0; +- #else +- return -1; +- #endif +- }], +-# MPFILES=$GMPDIR/mpn/mul_n.o +-# PATCHED_SYMBOLS=__gmpn_toom3_mul_n +- MPFILES= +- PATCHED_SYMBOLS= +-# if test "$use" = "m68k-linux" ; then +-# MPFILES="$MPFILES $GMPDIR/mpn/lshift.o $GMPDIR/mpn/rshift.o" +-# PATCHED_SYMBOLS="$PATCHED_SYMBOLS __gmpn_lshift __gmpn_rshift" +-# fi +- TLIBS="$TLIBS -lgmp" +- echo "#include \"gmp.h\"" >foo.c +- echo "int main() {return 0;}" >>foo.c +- MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` +- rm -f foo.c, +- echo "Cannot use dynamic gmp lib" , echo "Cannot use dynamic gmp lib" ), +- echo "Cannot use dynamic gmp lib" ,), +- echo "Cannot use dynamic gmp lib" ,) +-fi +- +-NEED_LOCAL_GMP='' +-if test "$MP_INCLUDE" = "" ; then +- NEED_LOCAL_GMP=1; +-fi +-if test "$PATCHED_SYMBOLS" != "" ; then +- NEED_LOCAL_GMP=1; ++if test "$enable_dynsysgmp" != "no" ; then ++ AC_CHECK_HEADERS( ++ [gmp.h], ++ [AC_CHECK_LIB( ++ [gmp],[__gmpz_init], ++ [AC_MSG_CHECKING([for external gmp version]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ #if __GNU_MP_VERSION > 3 ++ return 0; ++ #else ++ return -1; ++ #endif ++ ]])], ++ [AC_MSG_RESULT([good]) ++ TLIBS="$TLIBS -lgmp" ++ echo "#include \"gmp.h\"" >foo.c ++ echo "int main() {return 0;}" >>foo.c ++ MP_INCLUDE=`cpp foo.c | $AWK '/(\/|\\\\)gmp.h/ {if (!i) print $3;i=1}' | tr -d '"'` ++ rm -f foo.c])])]) ++ ++ if test "$MP_INCLUDE" = "" ; then ++ AC_MSG_RESULT([Cannot use dynamic gmp lib]) ++ fi ++ + fi + +-if test "$NEED_LOCAL_GMP" != "" ; then +- +- GMPDIR=gmp4 +- AC_MSG_CHECKING([use_gmp=yes, doing configure in gmp directory]) +- echo +- echo "#" +- echo "#" +- echo "# -------------------" +- echo "# Subconfigure of GMP" +- echo "#" +- echo "#" +- +- if test "$use_common_binary" = "yes"; then +- cd $GMPDIR && ./configure --build=$host && cd .. +- else +- cd $GMPDIR && ./configure && cd .. +- fi +- #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" +- +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of GMP done" +- echo "# ------------------------" +- echo "#" +- +- if test "$MP_INCLUDE" = "" ; then +- cp $GMPDIR/gmp.h h/gmp.h +- MP_INCLUDE=h/gmp.h +- MPFILES=gmp_all +- fi + ++if test "$MP_INCLUDE" = "" ; then ++ ++ GMPDIR=gmp4 ++ AC_MSG_CHECKING([doing configure in gmp directory]) ++ echo ++ echo "#" ++ echo "#" ++ echo "# -------------------" ++ echo "# Subconfigure of GMP" ++ echo "#" ++ echo "#" ++ ++ if test "$use_common_binary" = "yes"; then ++ cd $GMPDIR && ./configure --build=$host && cd .. ++ else ++ cd $GMPDIR && ./configure --host=$host --build=$build && cd .. ++ fi ++ #MY_SUBDIRS="$MY_SUBDIRS $GMPDIR" ++ ++ echo "#" ++ echo "#" ++ echo "#" ++ echo "# Subconfigure of GMP done" ++ echo "# ------------------------" ++ echo "#" ++ ++ if test "$MP_INCLUDE" = "" ; then ++ cp $GMPDIR/gmp.h h/gmp.h ++ MP_INCLUDE=h/gmp.h ++ MPFILES=gmp_all ++ fi + fi + +-AC_MSG_CHECKING("for leading underscore in object symbols") ++AC_MSG_CHECKING([for leading underscore in object symbols]) + cat>foo.c < + #include +@@ -905,12 +616,12 @@ int main() {FILE *f;double d=0.0;getc(f) + EOFF + $CC -c foo.c -o foo.o + if nm foo.o |grep " U " | grep "_cos" >/dev/null || nm foo.o |grep " U " | grep " _getc" >/dev/null ; then +- LEADING_UNDERSCORE=1 +- AC_DEFINE(LEADING_UNDERSCORE,1,[symbol name mangling convention]) +- AC_MSG_RESULT("yes") ++ LEADING_UNDERSCORE=1 ++ AC_DEFINE(LEADING_UNDERSCORE,1,[symbol name mangling convention]) ++ AC_MSG_RESULT("yes") + else +- LEADING_UNDERSCORE="" +- AC_MSG_RESULT("no") ++ LEADING_UNDERSCORE="" ++ AC_MSG_RESULT("no") + fi + + +@@ -918,61 +629,63 @@ AC_MSG_CHECKING("for GNU ld option -Map" + touch map + $CC -o foo [ -Wl,-Map ] map foo.o >/dev/null 2>&1 + if test `cat map | wc -l` != "0" ; then +- AC_MSG_RESULT("yes") +- AC_DEFINE(HAVE_GNU_LD,1,[gnu linker present]) +- GNU_LD=1 ++ AC_MSG_RESULT("yes") ++ AC_DEFINE(HAVE_GNU_LD,1,[gnu linker present]) ++ GNU_LD=1 + else +- AC_MSG_RESULT("no") +- GNU_LD= ++ AC_MSG_RESULT("no") ++ GNU_LD= + fi + rm -f foo.c foo.o foo map + + AC_MSG_CHECKING([for size of gmp limbs]) + AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- #include "$MP_INCLUDE" +- ]],[[ +- FILE *fp=fopen("conftest1","w"); +- fprintf(fp,"%u",sizeof(mp_limb_t)); +- fclose(fp); +- return 0; +- ]])],[mpsize=`cat conftest1`],[AC_MSG_ERROR([Cannot determine mpsize])]) ++ #include ++ #include "$MP_INCLUDE" ++ ]], ++ [[ ++ FILE *fp=fopen("conftest1","w"); ++ fprintf(fp,"%u",sizeof(mp_limb_t)); ++ fclose(fp); ++ ]])],[mpsize=`cat conftest1`],[AC_MSG_ERROR([Cannot determine mpsize])]) + AC_DEFINE_UNQUOTED(MP_LIMB_BYTES,$mpsize,[sizeof mp_limb in gmp library]) + AC_MSG_RESULT($mpsize) + + AC_MSG_CHECKING([_SHORT_LIMB]) + AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- #include "$MP_INCLUDE" +- ]],[[ +- #ifdef _SHORT_LIMB +- return 0; +- #else +- return 1; +- #endif +- ]])],[AC_DEFINE(__SHORT_LIMB,1,[short gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) ++ #include ++ #include "$MP_INCLUDE" ++ ]], ++ [[ ++ #ifdef _SHORT_LIMB ++ return 0; ++ #else ++ return 1; ++ #endif ++ ]])],[AC_DEFINE(__SHORT_LIMB,1,[short gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) + + AC_MSG_CHECKING([_LONG_LONG_LIMB]) + AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- #include "$MP_INCLUDE" +- ]],[[ +- #ifdef _LONG_LONG_LIMB +- return 0; +- #else +- return 1; +- #endif +- ]])],[AC_DEFINE(__LONG_LONG_LIMB,1,[long gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) +- +- GMP=1 +- AC_DEFINE(GMP,1,[using gmp]) +- AC_SUBST(GMP) +- AC_SUBST(GMPDIR) +- echo > makedefsafter +- echo "MPFILES=$MPFILES" >> makedefsafter +- echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter +- echo >> makedefsafter +-fi ++ #include ++ #include "$MP_INCLUDE" ++ ]], ++ [[ ++ #ifdef _LONG_LONG_LIMB ++ return 0; ++ #else ++ return 1; ++ #endif ++ ]])],[AC_DEFINE(__LONG_LONG_LIMB,1,[long gmp3 limbs]) AC_MSG_RESULT(yes)],[AC_MSG_RESULT(no)]) ++ ++GMP=1 ++AC_DEFINE(GMP,1,[using gmp]) ++AC_SUBST(GMP) ++AC_SUBST(GMPDIR) ++echo > makedefsafter ++echo "MPFILES=$MPFILES" >> makedefsafter ++echo "PATCHED_SYMBOLS=$PATCHED_SYMBOLS" >> makedefsafter ++echo >> makedefsafter ++ + + + # +@@ -980,30 +693,13 @@ fi + # + + if test "$enable_xgcl" = "yes" ; then +- +- AC_PATH_X +-# AC_PATH_XTRA +-# echo $X_CFLAGS +-# echo $X_LIBS +-# echo $X_EXTRA_LIBS +-# echo $X_PRE_LIBS +- +- miss=0 +-# AC_CHECK_LIB(Xmu,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#FIXME remove these +-# AC_CHECK_LIB(Xt,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) +-# AC_CHECK_LIB(Xext,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS) +-# AC_CHECK_LIB(Xaw,main,X_LIBS="$X_LIBS",miss=1,$X_LIBS)#until here +- AC_CHECK_LIB(X11,main,X_LIBS="$X_LIBS -lX11",miss=1,$X_LIBS) +- +- if test "$miss" = "1" ; then +- X_CFLAGS= +- X_LIBS= +- X_EXTRA_LIBS= +- X_PRE_LIBS= +- echo missing x libraries -- cannot compile xgcl +- else +- AC_DEFINE(HAVE_XGCL,1,[using xgcl]) +- fi ++ ++ AC_PATH_X ++ ++ AC_CHECK_LIB(X11,main, ++ [X_LIBS="$X_LIBS -lX11" AC_DEFINE(HAVE_XGCL,1,[using xgcl])], ++ [AC_MSG_RESULT([missing x libraries -- cannot compile xgcl])]) ++ + fi + + +@@ -1015,225 +711,194 @@ AC_SUBST(X_CFLAGS) + # + + if test "$enable_dlopen" = "yes" ; then ++ ++ AC_CHECK_LIB([dl],[dlopen],,AC_MSG_ERROR([Cannot find dlopen])) ++ ++ TLIBS="$TLIBS -ldl -rdynamic" ++ assert_arg_to_tcflags -fPIC ++ AC_DEFINE(USE_DLOPEN,1,[link compiled objects via libdl]) + +- AC_CHECK_LIB(dl,dlopen,have_dl=1,have_dl=0) +- if test "$have_dl" = "0" ; then +- echo "Cannot find dlopen in -dl" +- exit 1 +- fi +-dnl AC_SEARCH_LIBS(dlopen, dl, have_dl=1, AC_ERROR(dlopen not found)) +-dnl LIBS and TLIBS - why not merged from the beginning? +- +- TLIBS="$TLIBS -ldl -rdynamic" +- TCFLAGS="-fPIC $TCFLAGS" +-dnl TLIBS="$TLIBS -rdynamic" +- AC_DEFINE(USE_DLOPEN,1,[link compiled objects via libdl]) + fi + + if test "$enable_statsysbfd" = "yes" || test "$enable_dynsysbfd" = "yes" ; then +- AC_CHECK_HEADERS(bfd.h, +- AC_CHECK_LIB(bfd,bfd_init, +- # +- # Old binutils appear to need CONST defined to const +- # +- AC_MSG_CHECKING(if need to define CONST for bfd) +- AC_TRY_RUN([#define IN_GCC +- #include +- int main() { symbol_info t; return 0;}], +- AC_MSG_RESULT(no), +- AC_TRY_RUN([#define CONST const +- #define IN_GCC +- #include +- int main() {symbol_info t; return 0;}], +- AC_MSG_RESULT(yes) +- AC_DEFINE(NEED_CONST,1,[binutils requires CONST definition]), +- AC_MSG_ERROR([cannot use bfd]), +- AC_MSG_ERROR([cannot use bfd])), +- AC_MSG_ERROR([cannot use bfd])) +- ,,-liberty)) +- +- AC_DEFINE(HAVE_LIBBFD,1,[use libbfd]) +- +-# +-# BFD boolean syntax +-# +- +- AC_MSG_CHECKING(for useable bfd_boolean) +- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #define IN_GCC +- #include +- bfd_boolean foo() {return FALSE;} +- ]],[[return 0;]])], +- [AC_MSG_RESULT(yes) +- AC_DEFINE(HAVE_BFD_BOOLEAN,1,[bfd_boolean defined])], +- [AC_MSG_RESULT(no)]) +- +-# +-# bfd_link_info.output_bfd minimal configure change check +-# +- +- AC_CHECK_MEMBER([struct bfd_link_info.output_bfd], +- AC_DEFINE(HAVE_OUTPUT_BFD,1,[output_bfd element present]), [], +- [ +- #include +- #include +- ]) +- AC_SUBST(HAVE_OUTPUT_BFD) +- +-# +-# FIXME: Need to workaround mingw before this point -- CM +-# +- if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then +- echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c +- MP=`$CC [ -Wl,-M ] -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` +- rm -f foo.c foo +- if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then +- LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[[j]]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[[j]],j!=i ? "/" : "")}'`" +- else +- AC_MSG_ERROR([cannot locate external libbfd.a]) +- fi +- if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then +- LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,"/");for (j=1;j<=i;j++) if (j>1 && A[[j]]=="..") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf("%s%s",A[[j]],j!=i ? "/" : "")}'`" +- else +- AC_MSG_ERROR([cannot locate external libiberty.a]) +- fi +- BUILD_BFD=copy_bfd +- AC_CHECK_LIB(z,inflate, +- [TLIBS="$TLIBS -lz"], +- AC_MSG_ERROR([Need zlib for bfd linking]),[]) +- AC_CHECK_LIB(dl,dlsym, +- [TLIBS="$TLIBS -ldl"], +- AC_MSG_ERROR([Need libdl for bfd linking]),[]) +- AC_SUBST(BUILD_BFD) +- AC_SUBST(LIBBFD) +- AC_SUBST(LIBIBERTY) +- ++ AC_CHECK_HEADERS( ++ [bfd.h], ++ AC_CHECK_LIB( ++ [bfd],[bfd_init], ++ # ++ # Old binutils appear to need CONST defined to const ++ # ++ AC_MSG_CHECKING([need to define CONST for bfd]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #define IN_GCC ++ #include ++ ]], ++ [[ ++ symbol_info t; ++ ]])], ++ AC_MSG_RESULT([no]), ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #define CONST const ++ #define IN_GCC ++ #include ++ ]], ++ [[ ++ symbol_info t; ++ ]])], ++ AC_MSG_RESULT([yes]) ++ AC_DEFINE(NEED_CONST,1,[binutils requires CONST definition]), ++ AC_MSG_ERROR([cannot use bfd]), ++ AC_MSG_ERROR([cannot use bfd])), ++ AC_MSG_ERROR([cannot use bfd])) ++ ,,-liberty)) ++ ++ AC_DEFINE(HAVE_LIBBFD,1,[use libbfd]) ++ ++ # ++ # BFD boolean syntax ++ # ++ ++ AC_MSG_CHECKING(for useable bfd_boolean) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #define IN_GCC ++ #include ++ bfd_boolean foo() {return FALSE;} ++ ]], ++ [[]])], ++ [AC_MSG_RESULT(yes) ++ AC_DEFINE(HAVE_BFD_BOOLEAN,1,[bfd_boolean defined])], ++ [AC_MSG_RESULT(no)]) ++ ++ # ++ # bfd_link_info.output_bfd minimal configure change check ++ # ++ ++ AC_CHECK_MEMBER([struct bfd_link_info.output_bfd], ++ AC_DEFINE(HAVE_OUTPUT_BFD,1,[output_bfd element present]), [], ++ [[ ++ #include ++ #include ++ ]]) ++ AC_SUBST(HAVE_OUTPUT_BFD) ++ ++ # ++ # FIXME: Need to workaround mingw before this point -- CM ++ # ++ if test "$enable_statsysbfd" = "yes" && ! $CC -v 2>&1 | fgrep ming > /dev/null ; then ++ echo 'int main() {bfd_init();bfd_openr("/dev/null",0);return 0;}' >foo.c ++ MP=`$CC [ -Wl,-M ] -static -o foo foo.c -lbfd -liberty -ldl 2>&1 | grep -v : | tr '()' '\012\012' | $AWK '{print $NF}' | sort | uniq` ++ rm -f foo.c foo ++ if echo $MP | tr ' ' '\012' | grep libbfd.a >/dev/null; then ++ LIBBFD="`echo $MP | tr ' ' '\012' | grep libbfd.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[[j]]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[[j]],j!=i ? \"/\" : \"\")}'`" + else +- TLIBS="$TLIBS -lbfd -liberty -ldl" +- fi +-fi +- +-if test "$enable_locbfd" = "yes" ; then +- +- # check for gettext. It is part of glibc, but others +- # need GNU gettext separately. +-# AC_CHECK_HEADERS(libintl.h, true, +-# AC_MSG_ERROR(libintl.h (gettext) not found)) +-# AC_SEARCH_LIBS(dgettext, intl, true, AC_MSG_ERROR(gettext library not found)) +- +- echo "#" +- echo "#" +- echo "# -------------------------" +- echo "# Subconfigure of LIBINTL" +- echo "#" +- echo "#" +- cd binutils/intl && chmod +x configure && ./configure --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of LIBINTL done" +- echo "# ------------------------------" +- echo "#" +- echo "#" +- echo "#" +- echo "# -------------------------" +- echo "# Subconfigure of LIBIBERTY" +- echo "#" +- echo "#" +- cd binutils/libiberty && chmod +x configure && ./configure --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/libiberty " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of LIBIBERTY done" +- echo "# ------------------------------" +- echo "#" +- echo "#" +- echo "#" +- echo "# -------------------" +- echo "# Subconfigure of BFD" +- echo "#" +- echo "#" +- cd binutils/bfd && chmod +x configure && ./configure --with-included-gettext --disable-nls && cd ../.. +-# MY_SUBDIRS="$MY_SUBDIRS binutils/bfd " +- echo "#" +- echo "#" +- echo "#" +- echo "# Subconfigure of BFD done" +- echo "# ------------------------" +- echo "#" +-# TLIBS="$TLIBS `pwd`/binutils/bfd/libbfd.a `pwd`/binutils/libiberty/libiberty.a" +- AC_DEFINE(HAVE_LIBBFD,1,[use libbfd]) +- BUILD_BFD="h/bfd.h h/bfdlink.h h/ansidecl.h h/symcat.h" ++ AC_MSG_ERROR([cannot locate external libbfd.a]) ++ fi ++ if echo $MP | tr ' ' '\012' | grep libiberty.a >/dev/null ; then ++ LIBIBERTY="`echo $MP | tr ' ' '\012' | grep libiberty.a | $AWK '{i=split($1,A,\"/\");for (j=1;j<=i;j++) if (j>1 && A[[j]]==\"..\") {j--;i-=2;for (k=j;k<=i;k++) A[[k]]=A[[k+2]];j--;}} END {for (j=1;j<=i;j++) printf(\"%s%s\",A[[j]],j!=i ? \"/\" : \"\")}'`" ++ else ++ AC_MSG_ERROR([cannot locate external libiberty.a]) ++ fi ++ BUILD_BFD=copy_bfd ++ AC_CHECK_LIB(z,inflate, ++ [TLIBS="$TLIBS -lz"], ++ AC_MSG_ERROR([Need zlib for bfd linking]),[]) ++ AC_CHECK_LIB(dl,dlsym, ++ [TLIBS="$TLIBS -ldl"], ++ AC_MSG_ERROR([Need libdl for bfd linking]),[]) + AC_SUBST(BUILD_BFD) ++ AC_SUBST(LIBBFD) ++ AC_SUBST(LIBIBERTY) ++ ++ else ++ TLIBS="$TLIBS -lbfd -liberty -ldl" ++ fi + fi + ++AC_ARG_ENABLE([xdr],[ --enable-xdr=yes will compile in support for XDR]) + +-if test "$enable_xdr" = "yes" ; then +- AC_CHECK_FUNC(xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]), +- AC_CHECK_LIB(tirpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +- TLIBS="$TLIBS -ltirpc" TCFLAGS="$TCFLAGS -I/usr/include/tirpc", +- AC_CHECK_LIB(gssrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +- TLIBS="$TLIBS -lgssrpc" TCFLAGS="$TCFLAGS -I/usr/include/gssrpc", +- AC_CHECK_LIB(rpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +- TLIBS="$TLIBS -lrpc" TCFLAGS="$TCFLAGS -I/usr/include/rpc", +- AC_CHECK_LIB(oncrpc,xdr_double,AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) +- TLIBS="$TLIBS -loncrpc" TCFLAGS="$TCFLAGS -I/usr/include/oncrpc"))))) ++if test "$enable_xdr" != "no" ; then ++ XDR_LIB="" ++ AC_CHECK_FUNC([xdr_double],XDR_LIB=" ", ++ [AC_CHECK_LIB([tirpc],[xdr_double],[XDR_LIB=tirpc], ++ [AC_CHECK_LIB([gssrpc],[xdr_double],[XDR_LIB=gssrpc], ++ [AC_CHECK_LIB([rpc],[xdr_double],[XDR_LIB=rpc], ++ [AC_CHECK_LIB([oncrpc],[xdr_double],[XDR_LIB=oncrpc])])])])]) ++ ++ if test "$XDR_LIB" != ""; then ++ AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) ++ if test "$XDR_LIB" != " "; then ++ TLIBS="$TLIBS -l$XDR_LIB" ++ add_arg_to_tcflags -I/usr/include/$XDR_LIB ++ fi ++ fi + fi + + + AC_MSG_CHECKING([__builtin_clzl]) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- int main() { +- unsigned long u; +- long j; +- if (__builtin_clzl(0)!=sizeof(long)*8) +- return -1; +- for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) +- if (__builtin_clzl(u)!=j) +- return -1; +- return 0; +- }]])],[AC_MSG_RESULT([yes]) +- AC_DEFINE(HAVE_CLZL,[1],[clzl instruction])], +- [AC_MSG_RESULT([no])]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ unsigned long u; ++ long j; ++ if (__builtin_clzl(0)!=sizeof(long)*8) ++ return -1; ++ for (u=1,j=sizeof(long)*8-1;j>=0;j--,u<<=1) ++ if (__builtin_clzl(u)!=j) ++ return -1; ++ ]])], ++ [AC_MSG_RESULT([yes]) ++ AC_DEFINE(HAVE_CLZL,[1],[clzl instruction])], ++ [AC_MSG_RESULT([no])]) + + AC_MSG_CHECKING([__builtin_ctzl]) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- int main() { +- unsigned long u; +- long j; +- if (__builtin_ctzl(0)!=sizeof(long)*8) +- return -1; +- for (u=1,j=0;j ++ #include ++ ]], ++ [[ ++ unsigned long u; ++ long j; ++ if (__builtin_ctzl(0)!=sizeof(long)*8) ++ return -1; ++ for (u=1,j=0;j +- #include +- #ifdef __CYGWIN__ +- #define getpagesize() 4096 +- #endif +- ]],[[ +- size_t i=getpagesize(),j; +- FILE *fp=fopen("conftest1","w"); +- for (j=0;i>>=1;j++); +- j=j<$min_pagewidth ? $min_pagewidth : j; +- fprintf(fp,"%u",j); +- return 0; +- ]])], +- [PAGEWIDTH=`cat conftest1`], +- [PAGEWIDTH=0]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ #ifdef __CYGWIN__ ++ #define getpagesize() 4096 ++ #endif ++ ]], ++ [[ ++ size_t i=getpagesize(),j; ++ FILE *fp=fopen("conftest1","w"); ++ for (j=0;i>>=1;j++); ++ j=j<$min_pagewidth ? $min_pagewidth : j; ++ fprintf(fp,"%u",j); ++ ]])], ++ [PAGEWIDTH=`cat conftest1`], ++ [PAGEWIDTH=0]) + AC_MSG_RESULT($PAGEWIDTH) + AC_DEFINE_UNQUOTED(PAGEWIDTH,$PAGEWIDTH,[system pagewidth]) + AC_SUBST(PAGEWIDTH) + + AC_MSG_CHECKING([for required object alignment]) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "./h/enum.h" +- #define OBJ_ALIGN +- #include "./h/type.h" +- #include "./h/lu.h" +- #include "./h/object.h" +- ]],[[ +- unsigned long i; +- FILE *fp=fopen("conftest1","w"); +- for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); +- if (!i) return -1; +- fprintf(fp,"%lu",i); +- fclose(fp); +- return 0; +- ]])], +- [obj_align=`cat conftest1` +- AC_MSG_RESULT($obj_align) +- AC_DEFINE_UNQUOTED(OBJ_ALIGNMENT,$obj_align,[needed object alignment in bytes])], +- [AC_MSG_ERROR([Cannot find object alignent])]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #define EXTER ++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "./h/enum.h" ++ #define OBJ_ALIGN ++ #include "./h/type.h" ++ #include "./h/lu.h" ++ #include "./h/object.h" ++ ]], ++ [[ ++ unsigned long i; ++ FILE *fp=fopen("conftest1","w"); ++ for (i=1;i && NOT_OBJECT_ALIGNED(i); i<<=1); ++ if (!i) return -1; ++ fprintf(fp,"%lu",i); ++ fclose(fp); ++ return 0; ++ ]])], ++ [obj_align=`cat conftest1` ++ AC_MSG_RESULT($obj_align) ++ AC_DEFINE_UNQUOTED(OBJ_ALIGNMENT,$obj_align,[needed object alignment bytes])], ++ [AC_MSG_ERROR([Cannot find object alignent])]) + + AC_MSG_CHECKING([for C extension variable alignment]) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[]],[[ +- char *v __attribute__ ((aligned ($obj_align))); +- return 0;]])],[obj_align="__attribute__ ((aligned ($obj_align)))"],[AC_MSG_ERROR([Need alignment attributes])]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[]], ++ [[ ++ char *v __attribute__ ((aligned ($obj_align))); ++ ]])],[obj_align="__attribute__ ((aligned ($obj_align)))"],[AC_MSG_ERROR([Need alignment attributes])]) + AC_MSG_RESULT($obj_align) + AC_DEFINE_UNQUOTED(OBJ_ALIGN,$obj_align,[can use C extension for object alignment]) + + AC_MSG_CHECKING([for C extension noreturn function attribute]) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[]],[[ +- extern int v() __attribute__ ((noreturn)); +- return 0;]])],[no_return="__attribute__ ((noreturn))"],[no_return=]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM([[]], ++ [[ ++ extern int v() __attribute__ ((noreturn)); ++ ]])], ++ [no_return="__attribute__ ((noreturn))"],[no_return=]) + AC_MSG_RESULT($no_return) + AC_DEFINE_UNQUOTED(NO_RETURN,$no_return,[can use C extension for functions that do not return]) + +-AC_MSG_CHECKING(sizeof struct contblock) ++AC_MSG_CHECKING([sizeof struct contblock]) ++ ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #define EXTER ++ #define INLINE ++ #include "$MP_INCLUDE" ++ #include "h/enum.h" ++ #include "h/type.h" ++ #include "h/lu.h" ++ #include "h/object.h" ++ ]], ++ [[ ++ FILE *f=fopen("conftest1","w"); ++ fprintf(f,"%u",sizeof(struct contblock)); ++ fclose(f); ++ ]])], ++ [sizeof_contblock=`cat conftest1`], ++ [AC_MSG_ERROR([Cannot find sizeof struct contblock])], ++ [AC_MSG_ERROR([Cannot find sizeof struct contblock])]) + +-# work around MSYS pwd result incompatibility +-if test "$use" = "mingw" ; then +-AC_TRY_RUN([#include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "h/enum.h" +- #include "h/type.h" +- #include "h/lu.h" +- #include "h/object.h" +- int main(int argc,char **argv,char **envp) { +- FILE *f=fopen("conftest1","w"); +- fprintf(f,"%u",sizeof(struct contblock)); +- fclose(f); +- return 0; +- }],sizeof_contblock=`cat conftest1`, +- echo Cannot find sizeof struct contblock;exit 1, +- echo Cannot find sizeof struct contblock;exit 1) +-else +-AC_TRY_RUN([#include +- #define EXTER +- #define INLINE +- #include "$MP_INCLUDE" +- #include "`pwd`/h/enum.h" +- #include "`pwd`/h/type.h" +- #include "`pwd`/h/lu.h" +- #include "`pwd`/h/object.h" +- int main(int argc,char **argv,char **envp) { +- FILE *f=fopen("conftest1","w"); +- fprintf(f,"%u",sizeof(struct contblock)); +- fclose(f); +- return 0; +- }],sizeof_contblock=`cat conftest1`, +- echo Cannot find sizeof struct contblock;exit 1, +- echo Cannot find sizeof struct contblock;exit 1) +-fi + AC_MSG_RESULT($sizeof_contblock) + AC_DEFINE_UNQUOTED(SIZEOF_CONTBLOCK,$sizeof_contblock,[sizeof linked list for contiguous pages]) + + AC_MSG_CHECKING([for sbrk]) + HAVE_SBRK="" +-AC_TRY_RUN([#include +- #include +- int main() { ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ + FILE *f; + if (!(f=fopen("conftest1","w"))) +- return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0; +- }], +- HAVE_SBRK=1 +- AC_MSG_RESULT(yes), +- AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx]), +- AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx])) ++ return -1; ++ fprintf(f,"%u",sbrk(0)); ++ ]])], ++ [HAVE_SBRK=1;AC_MSG_RESULT([yes])], ++ AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx]), ++ AC_MSG_RESULT([no: WARNING you must be able to emulate sbrk: as on mingw or macosx])) + + if test "$use" = "386-macosx" ; then +- AC_MSG_RESULT(emulating sbrk for mac); +- HAVE_SBRK=0 ++ AC_MSG_RESULT([emulating sbrk for mac]); ++ HAVE_SBRK=0 + fi + + if test "$HAVE_SBRK" = "1" ; then +- +- AC_MSG_CHECKING([for ADDR_NO_RANDOMIZE constant]) +- AC_RUN_IFELSE([ +- AC_LANG_PROGRAM([[ +- #include +- #include +- ]],[[ +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_NO_RANDOMIZE); +- return 0; +- ]])], ++ ++ AC_MSG_CHECKING([for ADDR_NO_RANDOMIZE constant]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_NO_RANDOMIZE); ++ ]])], + [ADDR_NO_RANDOMIZE=`cat conftest1` +- AC_MSG_RESULT([yes $ADDR_NO_RANDOMIZE])], ++ AC_MSG_RESULT([yes $ADDR_NO_RANDOMIZE])], + [ADDR_NO_RANDOMIZE=0 +- AC_MSG_RESULT([no assuming 0x40000]) +- AC_DEFINE_UNQUOTED(ADDR_NO_RANDOMIZE,0x40000,[punt guess for no randomize value])]) +- +- AC_MSG_CHECKING([for ADDR_COMPAT_LAYOUT constant]) +- AC_RUN_IFELSE([ +- AC_LANG_PROGRAM([[ +- #include +- #include +- ]],[[ +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_COMPAT_LAYOUT); +- return 0; +- ]])], ++ AC_MSG_RESULT([no assuming 0x40000]) ++ AC_DEFINE_UNQUOTED(ADDR_NO_RANDOMIZE,0x40000,[punt guess for no randomize value])]) ++ ++ AC_MSG_CHECKING([for ADDR_COMPAT_LAYOUT constant]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_COMPAT_LAYOUT); ++ ]])], + [ADDR_COMPAT_LAYOUT=`cat conftest1` +- AC_MSG_RESULT([yes $ADDR_COMPAT_LAYOUT])], ++ AC_MSG_RESULT([yes $ADDR_COMPAT_LAYOUT])], + [ADDR_COMPAT_LAYOUT=0 +- AC_MSG_RESULT([no])] ++ AC_MSG_RESULT([no])] + AC_DEFINE_UNQUOTED(ADDR_COMPAT_LAYOUT,0,[constant to reserve upper 3Gb for C stack])) +- +- AC_MSG_CHECKING([for ADDR_LIMIT_3GB constant]) +- AC_RUN_IFELSE([ +- AC_LANG_PROGRAM([[ +- #include +- #include +- ]],[[ +- FILE *f; +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%x",ADDR_LIMIT_3GB); +- return 0; +- ]])], ++ ++ AC_MSG_CHECKING([for ADDR_LIMIT_3GB constant]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *f; ++ if (!(f=fopen("conftest1","w"))) return -1; ++ fprintf(f,"%x",ADDR_LIMIT_3GB); ++ ]])], + [ADDR_LIMIT_3GB=`cat conftest1` +- AC_MSG_RESULT([yes $ADDR_LIMIT_3GB])], ++ AC_MSG_RESULT([yes $ADDR_LIMIT_3GB])], + [ADDR_LIMIT_3GB=0 +- AC_MSG_RESULT([no])] ++ AC_MSG_RESULT([no])] + AC_DEFINE_UNQUOTED(ADDR_LIMIT_3GB,0,[only 3Gb of address space])) +- +- AC_MSG_CHECKING([for personality(ADDR_NO_RANDOMIZE) support]) +- AC_RUN_IFELSE([ +- AC_LANG_SOURCE([[ +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- #include "h/unrandomize.h" +- return 0;}]])], ++ ++ AC_MSG_CHECKING([for personality(ADDR_NO_RANDOMIZE) support]) ++ AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ int main(int argc,char *argv[],char *envp[]) { ++ #include "h/unrandomize.h" ++ return 0; ++ } ++ ]])], + [AC_MSG_RESULT(yes) +- AC_DEFINE(CAN_UNRANDOMIZE_SBRK,1,[can prevent sbrk from returning random values])], ++ AC_DEFINE(CAN_UNRANDOMIZE_SBRK,1,[can prevent sbrk from returning random values])], + [AC_MSG_RESULT(no)]) + +- AC_MSG_CHECKING([that sbrk is (now) non-random]) +- AC_TRY_RUN([#include +- #include ++ AC_MSG_CHECKING([that sbrk is (now) non-random]) ++ SBRK=0 ++ AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif +- if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0;}],SBRK=`cat conftest1`,SBRK=0,SBRK=0) +- if test "$SBRK" = "0" ; then +- AC_MSG_RESULT(cannot trap sbrk) +- exit 1 +- fi +- AC_TRY_RUN([#include +- #include ++ if (!(f=fopen("conftest1","w"))) ++ return -1; ++ fprintf(f,"%u",sbrk(0)); ++ return 0; ++ } ++ ]])],[SBRK=`cat conftest1`]) ++ if test "$SBRK" = "0" ; then ++ AC_MSG_ERROR([cannot trap sbrk]) ++ fi ++ ++ SBRK1=0 ++ AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include + int main(int argc,char * argv[],char * envp[]) { + FILE *f; + #ifdef CAN_UNRANDOMIZE_SBRK + #include "h/unrandomize.h" + #endif + if (!(f=fopen("conftest1","w"))) return -1; +- fprintf(f,"%u",sbrk(0)); +- return 0;}],SBRK1=`cat conftest1`,SBRK1=0,SBRK1=0) +- if test "$SBRK1" = "0" ; then +- AC_MSG_RESULT(cannot trap sbrk) +- exit 1 +- fi +- if test "$SBRK" = "$SBRK1" ; then +- AC_MSG_RESULT(yes) +- else +- AC_MSG_RESULT(no) +- echo "Cannot build with randomized sbrk. Your options:" +- echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" +- echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" +- echo " - run sysctl kernel.randomize_va_space=0 before using gcl" +- exit 1 +- fi ++ fprintf(f,"%u",sbrk(0)); ++ return 0; ++ } ++ ]])],[SBRK1=`cat conftest1`]) ++ if test "$SBRK1" = "0" ; then ++ AC_MSG_ERROR([cannot trap sbrk]) ++ fi ++ if test "$SBRK" = "$SBRK1" ; then ++ AC_MSG_RESULT([yes]) ++ else ++ AC_MSG_RESULT([no]) ++ echo "Cannot build with randomized sbrk. Your options:" ++ echo " - upgrade to a kernel/libc that knows about personality(ADDR_NO_RANDOMIZE)" ++ echo " - recompile your kernel with CONFIG_COMPAT_BRK (if it has that option)" ++ echo " - run sysctl kernel.randomize_va_space=0 before using gcl" ++ AC_MSG_ERROR([exiting]) ++ fi + fi +- +-dnl AC_MSG_CHECKING(DBEGIN) +-dnl AC_RUN_IFELSE([AC_LANG_SOURCE([[ +-dnl #include +-dnl #include +-dnl #include +-dnl void gprof_cleanup() {}; +- +-dnl int main(int argc,char **argv,char **envp) { +- +-dnl void *b; +-dnl FILE *fp; +- +-dnl #ifdef CAN_UNRANDOMIZE_SBRK +-dnl #include "h/unrandomize.h" +-dnl #endif +- +-dnl fp = fopen("conftest1","w"); +- +-dnl #ifdef _WIN32 +-dnl fprintf ( fp,"0x%lx", 0x3000000 ); /* Windows custom allocation from this point up */ +-dnl #else +-dnl #if defined (__APPLE__) && defined (__MACH__) +-dnl fprintf(fp,"0x0"); +-dnl #else +-dnl b = sbrk(0); +-dnl fprintf(fp,"0x%lx",((unsigned long) b) & ~(unsigned long)((1< +-dnl #include +-dnl ]],[[ +-dnl FILE *fp=fopen("conftest1","w"); +-dnl fprintf(fp,"%u",262144*( SIZEOF_LONG >>2)/(1<<($PAGEWIDTH-12))); +-dnl return 0;]])],[def_maxpage=`cat conftest1`],[def_maxpage=262144]) +- +-dnl AC_ARG_ENABLE(maxpage, +-dnl [ --enable-maxpage=XXXX will compile in a page table of size XXX +-dnl (eg '--enable-maxpage=64*1024' would produce +-dnl 64K pages allowing 256 MB if pages are 4K each)], +-dnl ,enable_maxpage=$def_maxpage) +- +- + AC_MSG_CHECKING(CSTACK_ADDRESS) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- void *v ; +- FILE *fp = fopen("conftest1","w"); +- unsigned long i,j; +- +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- j=1; +- j<<=$PAGEWIDTH; +- j<<=16; +- i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i-1); +- fclose(fp); +- return 0; +-}]])],[cstack_address=`cat conftest1`],[cstack_address=0]) ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ void * ++ foo() { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++ unsigned long i,j; ++ ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++ if (foo()>i) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i-1); ++ fclose(fp); ++ return 0; ++ }]])], ++ [cstack_address=`cat conftest1`],[cstack_address=0]) + AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address,[starting C stack address]) + AC_MSG_RESULT($cstack_address) + + AC_MSG_CHECKING([cstack bits]) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- void * +- foo() { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- void *v ; +- FILE *fp = fopen("conftest1","w"); +- unsigned long i,j; +- +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- j=1; +- j<<=$PAGEWIDTH; +- j<<=16; +- i=(unsigned long)&v; +- if (foo()>i) i-=j; +- j--; +- i+=j; +- i&=~j; +- for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); +- fprintf(fp,"%d",j); +- fclose(fp); +- return 0; +-}]])],[cstack_bits=`cat conftest1`],[cstack_bits=0]) ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ void * ++ foo() { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ void *v ; ++ FILE *fp = fopen("conftest1","w"); ++ unsigned long i,j; ++ ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=16; ++ i=(unsigned long)&v; ++ if (foo()>i) i-=j; ++ j--; ++ i+=j; ++ i&=~j; ++ for (j=0;(i>>j)!=(i>>(sizeof(long)*8-1));j++); ++ fprintf(fp,"%d",j); ++ fclose(fp); ++ return 0; ++ }]])], ++ [cstack_bits=`cat conftest1`],[cstack_bits=0]) + AC_DEFINE_UNQUOTED(CSTACK_BITS,$cstack_bits,[log starting C stack address]) + AC_MSG_RESULT($cstack_bits) + + AC_MSG_CHECKING(NEG_CSTACK_ADDRESS) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- return (long)$cstack_address<0 ? 0 : -1; +-}]])],[AC_MSG_RESULT(yes) +- neg_cstack_address=1 +- AC_DEFINE(NEG_CSTACK_ADDRESS,1,[C stack address is negative])], +- [AC_MSG_RESULT(no) +- neg_cstack_address=0]) +- ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ int ++ main(int argc,char **argv,char **envp) { ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ return (long)$cstack_address<0 ? 0 : -1; ++ }]])], ++ [AC_MSG_RESULT(yes) ++ neg_cstack_address=1 ++ AC_DEFINE(NEG_CSTACK_ADDRESS,1,[C stack address is negative])], ++ [AC_MSG_RESULT(no) ++ neg_cstack_address=0]) + + AC_MSG_CHECKING([finding CSTACK_ALIGNMENT]) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- int main(int argc,char **argv,char **envp) { +- void *b,*c; +- FILE *fp = fopen("conftest1","w"); +- long n; +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- b=alloca(sizeof(b)); +- c=alloca(sizeof(c)); +- n=b>c ? b-c : c-b; +- n=n>sizeof(c) ? n : 1; +- fprintf(fp,"%ld",n); +- fclose(fp); +- return 0; +-}]])],[cstack_alignment=`cat conftest1`],[cstack_alignment=0]) ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ int main(int argc,char **argv,char **envp) { ++ void *b,*c; ++ FILE *fp = fopen("conftest1","w"); ++ long n; ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ b=alloca(sizeof(b)); ++ c=alloca(sizeof(c)); ++ n=b>c ? b-c : c-b; ++ n=n>sizeof(c) ? n : 1; ++ fprintf(fp,"%ld",n); ++ fclose(fp); ++ return 0; ++ }]])], ++ [cstack_alignment=`cat conftest1`],[cstack_alignment=0]) + AC_DEFINE_UNQUOTED(CSTACK_ALIGNMENT,$cstack_alignment,[C stack alignment]) + AC_MSG_RESULT($cstack_alignment) + + AC_MSG_CHECKING(CSTACK_DIRECTION) +-AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- #include +- #include +- void * +- foo(void) { +- int i; +- return (void *)&i; +- } +- +- int main(int argc,char **argv,char **envp) { +- char *b; +- FILE *fp = fopen("conftest1","w"); +- #ifdef CAN_UNRANDOMIZE_SBRK +- #include "h/unrandomize.h" +- #endif +- fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); +- fclose(fp); +- return 0; +-}]])],[cstack_direction=`cat conftest1`],[cstack_direction=0]) ++AC_RUN_IFELSE( ++ [AC_LANG_SOURCE( ++ [[ ++ #include ++ #include ++ void * ++ foo(void) { ++ int i; ++ return (void *)&i; ++ } ++ ++ int ++ main(int argc,char **argv,char **envp) { ++ char *b; ++ FILE *fp = fopen("conftest1","w"); ++ #ifdef CAN_UNRANDOMIZE_SBRK ++ #include "h/unrandomize.h" ++ #endif ++ fprintf(fp,"%d",((long) &b) > ((long) foo()) ? -1 : 1); ++ fclose(fp); ++ return 0; ++ }]])], ++ [cstack_direction=`cat conftest1`],[cstack_direction=0]) + AC_DEFINE_UNQUOTED(CSTACK_DIRECTION,$cstack_direction,[whether C stack grows up or down]) + AC_MSG_RESULT($cstack_direction) + ++AC_ARG_ENABLE([immfix],[ --enable-immfix will enable an immediate fixnum table above the C stack]) + +-dnl AC_MSG_CHECKING(for shared library/C stack ceiling to heap) +-dnl if test "$use" = "mingw" ; then +-dnl heap_ceiling=2000000000 +-dnl else +-dnl if test "$use" = "solaris-i386" ; then +-dnl heap_ceiling=0x0 +-dnl else +-dnl if test "$enable_static" = "yes" ; then +-dnl heap_ceiling=0x0 +-dnl else +-dnl if ! test -x `which ldd` && ! test -f /proc/self/maps ; then +-dnl heap_ceiling=0x0 +-dnl else +-dnl if test -f /proc/self/maps ; then +-dnl heap_ceiling=0x`/bin/cat /proc/self/maps | grep "/lib.*/ld-" | cut -f1 -d- | head -1` +-dnl else +-dnl if test "`which ldd`" = "" ; then +-dnl heap_ceiling=0x0 +-dnl else +-dnl #echo -e "#include \n int main() {printf(\"foo\");return 0;}" >foo.c +-dnl #$CC foo.c -o foo +-dnl AAWK=`which awk` +-dnl # | grep -v ld-kfreebsd needed on some strange bsd amd64 boxes +-dnl heap_ceiling=`ldd $AAWK | tail -n 1 | $AWK '{print $NF}' | tr -d '()'` +-dnl fi +-dnl fi +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl ]],[[ +-dnl FILE *fp=fopen("conftest1","w"); +-dnl unsigned long h=$heap_ceiling,d=$dbegin,c=$cstack_address; +-dnl h=hd && cfoo.c +-dnl else +-dnl echo "int main() {return !($heap_ceiling && (unsigned long)$dbegin < (unsigned long)$cstack_address);}" >foo.c +-dnl fi +-dnl $CC foo.c -o foo +-dnl if ./foo ; then ++AC_ARG_ENABLE([fastimmfix],[ --enable-fastimmfix=XXXX will reject low immediate fixnums unless 2^XXX can be attained],,[enable_fastimmfix=64]) + +-if test "$use" != "386-gnu" ; then #hurd can push .data below C stack, but sbrk(0) remains above, foiling unexec + +- AC_MSG_CHECKING([finding default linker script]) +- touch unixport/gcl.script +- echo "int main() {return 0;}" >foo.c +- $CC -Wl,--verbose foo.c -o foo 2>&1 | \ +- $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script +- rm -rf foo.c foo +- +- if test "`cat gcl.script | wc -l`" != "0" ; then +- AC_MSG_RESULT(got it) +- AC_MSG_NOTICE([trying to adjust text start]) +- cp gcl.script gcl.script.def +- +- n=-1; +- k=0; +- lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; +- max=0; +- min=$lim; +- while test $n -lt $lim ; do +- j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script +-# diff -u gcl.script.def gcl.script +- echo "int main() {return 0;}" >foo.c +- if ( $CC -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then +- if test $n -lt $min ; then min=$n; fi; +- if test $n -gt $max; then max=$n; fi; +- elif test $max -gt 0 ; then +- break; +- fi; +- n=`$AWK 'END {print n+1}' n=$n foo.c ++ $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ ++ $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script ++ rm -rf foo.c foo ++ ++ if test "`cat gcl.script | wc -l`" != "0" ; then ++ AC_MSG_RESULT(got it) ++ AC_MSG_NOTICE([trying to adjust text start]) ++ cp gcl.script gcl.script.def ++ ++ n=-1; ++ k=0; ++ lim=`$AWK 'END {printf("%d\n",m*8-2)}' m=$ac_cv_sizeof_long`; ++ max=0; ++ min=$lim; ++ while test $n -lt $lim ; do ++ j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$n gcl.script ++ # diff -u gcl.script.def gcl.script ++ echo "int main() {return 0;}" >foo.c ++ if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++ if test $n -lt $min ; then min=$n; fi; ++ if test $n -gt $max; then max=$n; fi; ++ elif test $max -gt 0 ; then ++ break; ++ fi; ++ n=`$AWK 'END {print n+1}' n=$n gcl.script + AC_MSG_RESULT([done]) + rm -f gcl.script.def + LDFLAGS="$LDFLAGS -Wl,-T gcl.script " + cp gcl.script unixport +- else +- AC_MSG_RESULT([none found or not needed]) +- rm -f gcl.script gcl.script.def +- fi +- rm -rf foo.c foo +- else +- AC_MSG_RESULT([not found]) +- fi +- ++ else ++ AC_MSG_RESULT([none found or not needed]) ++ rm -f gcl.script gcl.script.def ++ fi ++ rm -rf foo.c foo ++ else ++ AC_MSG_RESULT([not found]) ++ fi ++ + else +- +- AC_DEFINE_UNQUOTED(OBJNULL,NULL,[lowest address non-object]) +- ++ ++ AC_DEFINE_UNQUOTED(OBJNULL,NULL,[lowest address non-object]) ++ + fi + +- dnl old_LDFLAGS="$LDFLAGS" +- dnl LDFLAGS="$LDFLAGS $TLDFLAGS" +- dnl AC_MSG_CHECKING([revised DBEGIN]) +- dnl AC_RUN_IFELSE([AC_LANG_SOURCE([[ +- dnl #include +- dnl #include +- dnl #include +- +- dnl int main(int argc,char **argv,char **envp) { +- +- dnl void *b; +- dnl FILE *fp; +- +- dnl #ifdef CAN_UNRANDOMIZE_SBRK +- dnl #include "h/unrandomize.h" +- dnl #endif +- dnl fp = fopen("conftest1","w"); +- +- dnl #ifdef _WIN32 +- dnl fprintf ( fp,"0x%lx", 0x1a000000 ); /* Windows custom allocation from this point up */ +- dnl #else +- dnl #if defined (__APPLE__) && defined (__MACH__) +- dnl fprintf(fp,"((unsigned long)get_dbegin())"); +- dnl #else +- dnl b = sbrk(0); +- dnl fprintf(fp,"0x%lx",((unsigned long) b) & ~(unsigned long)0xffffff); +- dnl #endif +- dnl #endif +- dnl fclose(fp); +- dnl return 0;}]])],[dbegin=`cat conftest1`],[dbegin=0]) +- dnl AC_MSG_RESULT($dbegin) +- dnl LDFLAGS="$old_LDFLAGS" +-dnl fi +-dnl dnl AC_DEFINE_UNQUOTED(DBEGIN,$dbegin,[down-rounded beginning address of lisp data]) +-dnl rm -rf foo* +- +-dnl AC_MSG_CHECKING(for maxpage revision) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl ]],[[ +-dnl char *b; +-dnl unsigned long i,j; +-dnl FILE *fp = fopen("conftest1","w"); +-dnl j=((unsigned long)$enable_maxpage <<$PAGEWIDTH) + $dbegin; +-dnl j=$heap_ceiling && j>$heap_ceiling ? $heap_ceiling : j; +-dnl j-=$dbegin; +-dnl /* for (i=1;i<<1 && i<=j;i<<=1); */ +-dnl /* if (i>j) i>>=1; */ +-dnl i=j; +-dnl fprintf(fp,"%ld",i>>$PAGEWIDTH); +-dnl fclose(fp); +-dnl return 0; +-dnl ]])],[tmp_maxpage=`cat conftest1`],[tmp_maxpage=0]) +-dnl if test "$tmp_maxpage" != "$enable_maxpage" ; then +-dnl enable_maxpage=$tmp_maxpage +-dnl AC_MSG_RESULT($enable_maxpage) +-dnl else +-dnl AC_MSG_RESULT($enable_maxpage is OK) +-dnl fi +-dnl AC_DEFINE_UNQUOTED(MAXPAGE,$enable_maxpage,[maximum number of pages to be allocated]) +- +-dnl AC_MSG_CHECKING(for C stack size floor from heap) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl ]],[[ +-dnl char *b; +-dnl FILE *fp = fopen("conftest1","w"); +-dnl unsigned long j,k; +- +-dnl j=$cstack_address + $cstack_direction * $enable_cssize; +-dnl k=($dbegin + ((unsigned long)$enable_maxpage << $PAGEWIDTH)); +-dnl j=abs(j-$cstack_address)!=$enable_cssize || (j +-dnl ]],[[ +-dnl char *b; +-dnl FILE *fp = fopen("conftest1","w"); +-dnl unsigned long j,k; +- +-dnl j=$cstack_address + $cstack_direction * $enable_cssize; +-dnl if ($cstack_direction>0) { +-dnl k=$cstack_address + ((-(unsigned long)$cstack_address)>>1); +-dnl j=j<$cstack_address || j > k ? k : j; +-dnl j=$cstack_address < $dbegin && j > $dbegin ? $dbegin : j; +-dnl } +-dnl j-=$cstack_address; +-dnl j*=$cstack_direction; +-dnl fprintf(fp,"%lu",j); +-dnl fclose(fp); +-dnl return 0; +-dnl ]])],[tmp_cssize=`cat conftest1`],[tmp_cssize=0]) +-dnl if test "$tmp_cssize" != "$enable_cssize" ; then +-dnl enable_cssize=$tmp_cssize; +-dnl AC_MSG_RESULT($enable_cssize) +-dnl else +-dnl AC_MSG_RESULT($enable_cssize is OK) +-dnl fi +- +-dnl AC_MSG_CHECKING(for C stack size limit from address wrap) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl ]],[[ +-dnl char *b; +-dnl FILE *fp = fopen("conftest1","w"); +-dnl unsigned long j,k; +- +-dnl j=-$cstack_address * $cstack_direction; +-dnl j=j>$enable_cssize ? $enable_cssize : j; +-dnl fprintf(fp,"%lu",j); +-dnl fclose(fp); +-dnl return 0; +-dnl ]])],[tmp_cssize=`cat conftest1`],[tmp_cssize=0]) +-dnl if test "$tmp_cssize" != "$enable_cssize" ; then +-dnl enable_cssize=$tmp_cssize; +-dnl AC_MSG_RESULT($enable_cssize) +-dnl else +-dnl AC_MSG_RESULT($enable_cssize is OK) +-dnl fi +-dnl AC_DEFINE_UNQUOTED(CSSIZE,$enable_cssize,[maximum C stack size]) +- +-dnl AC_MSG_CHECKING(for fast NULL_OR_ON_CSTACK macro) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl ]],[[ +-dnl return ((long)$dbegin>=0 && +-dnl ((long)$dbegin+(long)($enable_maxpage<<$PAGEWIDTH)) >=0 && +-dnl ((long)$cstack_address<0)) ? 0 : 1; +-dnl ]])],[tmp_fnocm=yes],[tmp_fnocm=no]) +-dnl if test "$tmp_fnocm" = "yes" ; then +-dnl AC_MSG_RESULT(yes) +-dnl AC_DEFINE(USE_FAST_NULL_OR_ON_CSTACK_MACRO,1,[whether one instruction heap address check can be used]) +-dnl else +-dnl AC_MSG_RESULT(no) +-dnl fi +- + mem_top=0 + mem_range=0 + AC_MSG_CHECKING(mem top) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- void *v; +- unsigned long i,j,k,l,m; +- FILE *fp = fopen("conftest1","w"); +- +- for (i=2,k=1;i;k=i,i<<=1); +- l=$cstack_address; +- l=$cstack_direction==1 ? (l>=1,i|=j); +- if (j<(k>>3)) i=0; +- j=1; +- j<<=$PAGEWIDTH; +- j<<=4; +- j--; +- i+=j; +- i&=~j; +- fprintf(fp,"0x%lx",i); +- fclose(fp); +- return 0; +-]])],[mem_top=`cat conftest1`],[mem_top="0x0"]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ void *v; ++ unsigned long i,j,k,l,m; ++ FILE *fp = fopen("conftest1","w"); ++ ++ for (i=2,k=1;i;k=i,i<<=1); ++ l=$cstack_address; ++ l=$cstack_direction==1 ? (l>=1,i|=j); ++ if (j<(k>>3)) i=0; ++ j=1; ++ j<<=$PAGEWIDTH; ++ j<<=4; ++ j--; ++ i+=j; ++ i&=~j; ++ fprintf(fp,"0x%lx",i); ++ fclose(fp); ++ return 0; ++ ]])], ++ [mem_top=`cat conftest1`],[mem_top="0x0"]) + AC_MSG_RESULT($mem_top) ++ + if test "$mem_top" != "0x0" ; then +- AC_MSG_CHECKING(finding upper mem half range) +- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- unsigned long j; +- FILE *fp = fopen("conftest1","w"); +- +- for (j=1;j && !(j& $mem_top);j<<=1); +- fprintf(fp,"0x%lx",j>>1); +- fclose(fp); +- return 0; +- ]])],[mem_range=`cat conftest1`],[mem_range="0x0"]) +- AC_MSG_RESULT($mem_range) +- if test "$mem_range" != "0x0" ; then ++ AC_MSG_CHECKING(finding upper mem half range) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ unsigned long j; ++ FILE *fp = fopen("conftest1","w"); ++ ++ for (j=1;j && !(j& $mem_top);j<<=1); ++ fprintf(fp,"0x%lx",j>>1); ++ fclose(fp); ++ return 0; ++ ]])], ++ [mem_range=`cat conftest1`],[mem_range="0x0"]) ++ AC_MSG_RESULT($mem_range) ++ if test "$mem_range" != "0x0" ; then + AC_DEFINE_UNQUOTED(MEM_TOP,$mem_top,[beginning address for immediate fixnum range]) + AC_DEFINE_UNQUOTED(MEM_RANGE,$mem_range,[size of immediate fixnum address space]) +- fi ++ fi + fi + +-if test "$enable_immfix" = "yes" ; then +- if test "$mem_top" != "0x0" ; then +- if test "$mem_range" != "0x0" ; then +- AC_DEFINE_UNQUOTED(IM_FIX_BASE,$mem_top,[beginning address for immediate fixnum range]) +- AC_DEFINE_UNQUOTED(IM_FIX_LIM,$mem_range,[size of immediate fixnum address space]) +- fi +- fi +-fi +- +- +-dnl AC_MSG_CHECKING(for word order) +-dnl AC_TRY_RUN([int main () { +-dnl /* Are we little or big endian? Adapted from Harbison&Steele. */ +-dnl union +-dnl { +-dnl double d; +-dnl int l[sizeof(double)/sizeof(int)]; +-dnl } u; +-dnl u.d = 1.0; +-dnl return u.l[sizeof(double)/sizeof(int)-1] ? 0 : 1; +-dnl }],AC_MSG_RESULT(little) +-dnl AC_DEFINE(LITTLE_END), +-dnl AC_MSG_RESULT(big), +-dnl AC_MSG_RESULT([WARNING: ASSUMING LITTLE ENDIAN FOR CROSS COMPILING !!!] +-dnl AC_DEFINE(LITTLE_END))) +-dnl AC_SUBST(LITTLE_END) +- +- +-# On systems with execshield, brk is randomized. We need to catch +-# this and restore the traditional behavior here +- +-dnl old_LDFLAGS="$LDFLAGS" +-dnl LDFLAGS="$TLDFLAGS" +-dnl AC_MSG_CHECKING("finding DBEGIN") +-dnl AC_TRY_RUN([#include +-dnl #include +- +-dnl void gprof_cleanup() {}; +-dnl int +-dnl main(int argc,char * argv[],char *envp[]) +-dnl { +-dnl char *b,*b1; +-dnl FILE *fp; +- +-dnl #ifdef CAN_UNRANDOMIZE_SBRK +-dnl #include "h/unrandomize.h" +-dnl #endif +-dnl b = (void *) malloc(1000); +-dnl fp = fopen("conftest1","w"); +- +-dnl #ifdef _WIN32 +-dnl fprintf(fp,"_dbegin"); +-dnl #else +-dnl #if defined (__APPLE__) && defined (__MACH__) +-dnl fprintf(fp,"mach_mapstart"); +-dnl #else +-dnl b1=((unsigned long) b) & ~(unsigned long)0xffffff;b=(void *)b1<(void *)&b1 && (void *)b>(void *)&b ? ((unsigned long) b) & ~(unsigned long)((1< +-dnl main() +-dnl { +-dnl char *b ; +-dnl FILE *fp = fopen("conftest1","w"); +-dnl fprintf(fp,"%ld",((long) &b)); +-dnl fclose(fp); +-dnl return 0; +-dnl }],cstack_address=`cat conftest1`,cstack_address=0,cstack_address=0) +-dnl AC_DEFINE_UNQUOTED(CSTACK_ADDRESS,$cstack_address \ +-dnl ) +-dnl AC_MSG_RESULT(got $cstack_address) +- +- ++if test "$enable_immfix" != "no" ; then ++ if test "$mem_top" != "0x0" ; then ++ if test "$mem_range" != "0x0" ; then ++ AC_DEFINE_UNQUOTED(IM_FIX_BASE,$mem_top,[beginning address for immediate fixnum range]) ++ AC_DEFINE_UNQUOTED(IM_FIX_LIM,$mem_range,[size of immediate fixnum address space]) ++ fi ++ fi ++fi + + AC_MSG_CHECKING([sizeof long long int]) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- if (sizeof(long long int) == 2*sizeof(long)) return 0; +- return 1; +-]])],[AC_DEFINE(HAVE_LONG_LONG,1,[long long is available]) AC_MSG_RESULT(yes)], ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ if (sizeof(long long int) == 2*sizeof(long)) return 0; ++ return 1; ++ ]])], ++ [AC_DEFINE(HAVE_LONG_LONG,1,[long long is available]) AC_MSG_RESULT(yes)], + [AC_MSG_RESULT(no)]) + + AC_SUBST(HAVE_LONG_LONG) + +- +-AC_CHECK_HEADERS(dirent.h, +- AC_MSG_CHECKING([for d_type]) +- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- struct dirent d; +- return d.d_type=0; +- ]])], +- [AC_MSG_RESULT([yes]) AC_DEFINE(HAVE_D_TYPE,1,[have struct dirent d_type field])], +- AC_MSG_RESULT([no]),AC_MSG_RESULT([no]))) +- +-# readline +-AC_ARG_ENABLE(readline, +- [--enable-readline enables command line completion via the readline library ],, +- enable_readline="yes") ++AC_CHECK_HEADERS([dirent.h], ++ AC_MSG_CHECKING([for d_type]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ struct dirent d; ++ return d.d_type=0; ++ ]])], ++ [AC_MSG_RESULT([yes]) AC_DEFINE(HAVE_D_TYPE,1,[have struct dirent d_type field])], ++ AC_MSG_RESULT([no]),AC_MSG_RESULT([no]))) + + # ansi lisp +-AC_ARG_ENABLE(ansi,[--enable-ansi builds a large gcl aiming for ansi compliance, +- --disable-ansi builds the smaller traditional CLtL1 image],,enable_ansi="yes") +- +-if test "$enable_ansi" = "yes" ; then +- SYSTEM=ansi_gcl +- CLSTANDARD=ANSI +-else +- SYSTEM=gcl +- CLSTANDARD=CLtL1 +-fi ++SYSTEM=ansi_gcl ++CLSTANDARD=ANSI ++AC_ARG_ENABLE([ansi],[ --enable-ansi builds a large gcl aiming for ansi compliance], ++ [if test "$enable_ansi" = "no" ; then ++ SYSTEM=gcl ++ CLSTANDARD=CLtL1 ++ fi]) + + FLISP="saved_$SYSTEM" + AC_SUBST(FLISP) +@@ -2192,51 +1574,44 @@ AC_EGREP_HEADER([gettimeofday], + [sys/time.h], + [AC_MSG_RESULT([present])], + [AC_MSG_RESULT([missing]) +- AC_DEFINE(GETTOD_NOT_DECLARED,1,[No gettimeofday call -- fixme])]) ++ AC_DEFINE(GETTOD_NOT_DECLARED,1,[No gettimeofday call -- fixme])]) + + + AC_CHECK_LIB(m,sin,LIBS="${LIBS} -lm",true) + AC_CHECK_LIB(mingwex,main,LIBS="${LIBS} -lmingwex",true) + + AC_MSG_CHECKING([for buggy maximum sscanf length]) +-AC_RUN_IFELSE([ +- AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; +- int n, m; +- double f; +- char *endptr; +- FILE *fp=fopen("conftest1","w"); +- +- n=sscanf(s,"%lf%n",&f,&m); +- fprintf(fp,"%d",m); +- fclose(fp); +- return s[m]; +- ]])], +- [AC_MSG_RESULT([none])], +- [buggy_maximum_sscanf_length=`cat conftest1` +- AC_MSG_RESULT([$buggy_maximum_sscanf_length]) +- AC_DEFINE_UNQUOTED(BUGGY_MAXIMUM_SSCANF_LENGTH,$buggy_maximum_sscanf_length,[sscanf terminates prematurely (Windows XP)])]) ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ char *s= "2.7182818284590452353602874713526624977572470936999595749669676277240766303535475945713821785251664274274663919320030599218174135966290435729003342952605956307381323286279434907632338298807531952510190115738341879307021540891499348841675092447614606680822648001684774118537423454424371075390777449920695517027618386062613313845830007520449338265602976067371132007093287091274437470472306969772093101416928368190255151086574637721112523897844250569536967707854499699679468644549059879316368892300987931277361782154249992295763514822082698951936680331825288693984964651058209392398294887933203625094431173012381970684161404"; ++ int n, m; ++ double f; ++ char *endptr; ++ FILE *fp=fopen("conftest1","w"); ++ ++ n=sscanf(s,"%lf%n",&f,&m); ++ fprintf(fp,"%d",m); ++ fclose(fp); ++ return s[m]; ++ ]])], ++ [AC_MSG_RESULT([none])], ++ [buggy_maximum_sscanf_length=`cat conftest1` ++ AC_MSG_RESULT([$buggy_maximum_sscanf_length]) ++ AC_DEFINE_UNQUOTED(BUGGY_MAXIMUM_SSCANF_LENGTH,$buggy_maximum_sscanf_length,[sscanf terminates prematurely (Windows XP)])]) + + + EXTRA_LOBJS= +-if test "$try_japi" = "yes" ; then +- AC_CHECK_HEADERS(japi.h,[AC_DEFINE(HAVE_JAPI_H) +- EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" +- LIBS="${LIBS} -ljapi -lwsock32"] ) +-fi +-dnl if test "$use" = "mingw" ; then +-dnl if test "$try_xdr" = "yes" ; then +-dnl AC_CHECK_HEADERS(rpc/rpc.h,[AC_DEFINE(HAVE_XDR) +-dnl LIBS="${LIBS} -loncrpc"] ) +-dnl fi +-dnl else +-dnl if test "$try_xdr" = "yes" ; then +-dnl AC_CHECK_HEADERS(rpc/rpc.h,[AC_DEFINE(HAVE_XDR) +-dnl LIBS="${LIBS} -lrpc"] ) +-dnl fi +-dnl fi ++AC_ARG_ENABLE([japi],[ --enable-japi=yes will compile in support for the JAPI graphical interface if present on your system], ++ [if test "$enable_japi" = "yes" ; then ++ AC_CHECK_HEADERS([japi.h], ++ [AC_DEFINE(HAVE_JAPI_H) ++ EXTRA_LOBJS="${EXTRA_LOBJS} gcl_japi.o" ++ LIBS="${LIBS} -ljapi -lwsock32"]) ++ fi]) + + # Should really find a way to check for prototypes, but this + # basically works for now. CM +@@ -2260,76 +1635,53 @@ AC_CHECK_HEADERS(float.h,AC_DEFINE(HAVE_ + # test makes sense. CM + # + AC_MSG_CHECKING([for isnormal]) +-AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #define _GNU_SOURCE +- #include +- ]],[[ +- float f; +- return isnormal(f) || !isnormal(f) ? 0 : 1; ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #define _GNU_SOURCE ++ #include ++ ]], ++ [[ ++ float f; ++ return isnormal(f) || !isnormal(f) ? 0 : 1; + ]])], +- [AC_DEFINE(HAVE_ISNORMAL,1,[Have isnormal function]) AC_MSG_RESULT(yes)], +- [AC_MSG_CHECKING([for fpclass in ieeefp.h]) +- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +- #include +- ]],[[ +- float f; +- return fpclass(f)>=FP_NZERO || fpclass(f) ++ ]], ++ [[ ++ float f; ++ return fpclass(f)>=FP_NZERO || fpclass(f) +- ]],[[ +- float f; +- return isfinite(f) || !isfinite(f) ? 0 : 1; +- ]])],[AC_DEFINE(HAVE_ISFINITE,1,[Have isfinite function]) AC_MSG_RESULT(yes)], +- [AC_MSG_CHECKING([for finite()]) +- AC_RUN_IFELSE([AC_LANG_PROGRAM([[ ++AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #define _GNU_SOURCE + #include +- #include +- ]],[[ ++ ]], ++ [[ + float f; +- return finite(f) || !finite(f) ? 0 : 1; +- ]])],[AC_DEFINE(HAVE_FINITE,1,[Have finite function]) AC_MSG_RESULT(yes)], +- [AC_MSG_ERROR(no)])]) +- +-dnl AC_MSG_CHECKING([for INFINITY]) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #define _GNU_SOURCE +-dnl #include +-dnl ]],[[ +-dnl double d=INFINITY; +-dnl return 0; +-dnl ]])],[AC_MSG_RESULT(yes)], +-dnl [AC_MSG_CHECKING([for builtin_inf()]) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl #include +-dnl ]],[[ +-dnl double d=__builtin_inf(); +-dnl return 0; +-dnl ]])],[AC_DEFINE_UNQUOTED(INFINITY,__builtin_inf(),[Have builtin_inf]) AC_MSG_RESULT(yes)], +-dnl [AC_MSG_ERROR(no)])]) +- +-dnl AC_MSG_CHECKING([for NAN]) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #define _GNU_SOURCE +-dnl #include +-dnl ]],[[ +-dnl double d=NAN; +-dnl return 0; +-dnl ]])],[AC_MSG_RESULT(yes)], +-dnl [AC_MSG_CHECKING([for builtin_nan()]) +-dnl AC_RUN_IFELSE([AC_LANG_PROGRAM([[ +-dnl #include +-dnl #include +-dnl ]],[[ +-dnl double d=__builtin_nan("0x0"); +-dnl return 0; +-dnl ]])],[AC_DEFINE_UNQUOTED(NAN,__builtin_nan("0x0"),[Have builtin_nan]) AC_MSG_RESULT(yes)], +-dnl [AC_MSG_ERROR(no)])]) ++ return isfinite(f) || !isfinite(f) ? 0 : 1; ++ ]])],[AC_DEFINE(HAVE_ISFINITE,1,[Have isfinite function]) AC_MSG_RESULT(yes)], ++ [AC_MSG_CHECKING([for finite()]) ++ AC_RUN_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ float f; ++ return finite(f) || !finite(f) ? 0 : 1; ++ ]])], ++ [AC_DEFINE(HAVE_FINITE,1,[Have finite function]) AC_MSG_RESULT(yes)], ++ [AC_MSG_ERROR(no)])]) + + #-------------------------------------------------------------------- + # Check for the existence of the -lsocket and -lnsl libraries. +@@ -2363,69 +1715,78 @@ if test "$tcl_checkBoth" = 1; then + fi + AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [TLIBS="$TLIBS -lnsl"])) + +-RL_OBJS="" +-RL_LIB="" +-if test "$enable_readline" = "yes" ; then +- AC_CHECK_HEADERS(readline/readline.h, +- AC_CHECK_LIB(readline,rl_initialize, +- AC_DEFINE(HAVE_READLINE,1,[have readline library]) +- TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware +- RL_OBJS=gcl_readline.o +-# Readline support now initialized automatically when compiled in, this lisp +-# object no longer needed -- 20040102 CM +-# RL_LIB=lsp/gcl_readline.o +- )) +- +-# These tests discover differences between readline 4.1 and 4.3 +- AC_CHECK_LIB(readline,rl_completion_matches, +- AC_DEFINE(HAVE_DECL_RL_COMPLETION_MATCHES,1,[have readline completion matches]) +- AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T,1,[have readline completion matches]),,) ++# readline ++AC_ARG_ENABLE(readline,[ --enable-readline enables command line completion via the readline library ]) ++ ++if test "$use" = "mingw" ; then ++ enable_readline=no ++fi ++ ++if test "$enable_readline" != "no" ; then ++ AC_CHECK_HEADERS([readline/readline.h], ++ AC_CHECK_LIB([readline],[rl_initialize], ++ [AC_DEFINE(HAVE_READLINE,1,[have readline library]) ++ TLIBS="$TLIBS -lreadline" #some machines don't link this, e.g. Slackware ++ RL_OBJS=gcl_readline.o])) ++ ++ # These tests discover differences between readline 4.1 and 4.3 ++ AC_CHECK_LIB([readline],[rl_completion_matches], ++ [AC_DEFINE(HAVE_DECL_RL_COMPLETION_MATCHES,1,[have readline completion matches]) ++ AC_DEFINE(HAVE_RL_COMPENTRY_FUNC_T,1,[have readline completion matches])]) + fi + + AC_SUBST(RL_OBJS) + AC_SUBST(RL_LIB) + +-AC_MSG_CHECKING(For network code for nsocket.c) +-AC_TRY_LINK([ +-#include +-#include +-#include +- +-#include +-#include +-#include +- +-/************* for the sockets ******************/ +-#include /* struct sockaddr, SOCK_STREAM, ... */ +-#ifndef NO_UNAME +-# include /* uname system call. */ +-#endif +-#include /* struct in_addr, struct sockaddr_in */ +-#include /* inet_ntoa() */ +-#include /* gethostbyname() */ +-],[ connect(0,(struct sockaddr *)0,0); +- gethostbyname("jil"); +- socket(AF_INET, SOCK_STREAM, 0); +- ], +-[AC_DEFINE(HAVE_NSOCKET,1,[can use nsocket library]) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) +- +- +-AC_MSG_CHECKING(check for listen using fcntl) +-AC_TRY_COMPILE([#include +-#include +-], +-[FILE *fp=fopen("configure.in","r"); +- int orig; +- orig = fcntl(fileno(fp), F_GETFL); +- if (! (orig & O_NONBLOCK )) return 0; +-], +-[AC_DEFINE(LISTEN_USE_FCNTL,1,[can use fcntl for listen function]) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) +- ++# sockets + ++AC_MSG_CHECKING([For network code for nsocket.c]) ++AC_LINK_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ #include ++ ++ #include ++ #include ++ #include ++ ++ /************* for the sockets ******************/ ++ #include /* struct sockaddr, SOCK_STREAM, ... */ ++ #ifndef NO_UNAME ++ # include /* uname system call. */ ++ #endif ++ #include /* struct in_addr, struct sockaddr_in */ ++ #include /* inet_ntoa() */ ++ #include /* gethostbyname() */ ++ ]], ++ [[ ++ connect(0,(struct sockaddr *)0,0); ++ gethostbyname("jil"); ++ socket(AF_INET, SOCK_STREAM, 0); ++ ]])], ++ [AC_DEFINE(HAVE_NSOCKET,1,[can use nsocket library]) ++ AC_MSG_RESULT([yes])], ++ [AC_MSG_RESULT([no])]) ++ ++ ++AC_MSG_CHECKING([check for listen using fcntl]) ++AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #include ++ ]], ++ [[ ++ FILE *fp=fopen("configure.in","r"); ++ int orig; ++ orig = fcntl(fileno(fp), F_GETFL); ++ if (! (orig & O_NONBLOCK )) return 0; ++ ]])], ++ [AC_DEFINE(LISTEN_USE_FCNTL,1,[can use fcntl for listen function]) ++ AC_MSG_RESULT([yes])], ++ [AC_MSG_RESULT([no])]) + + + AC_CHECK_FUNC(profil, ,[AC_DEFINE(NO_PROFILE,1,[no profil system call])]) +@@ -2433,29 +1794,18 @@ AC_SUBST(NO_PROFILE) + AC_CHECK_FUNC(setenv,[AC_DEFINE(HAVE_SETENV,1,[have setenv call])],no_setenv=1 ) + AC_SUBST(HAVE_SETENV) + if test "$no_setenv" = "1" ; then +-AC_CHECK_FUNC(putenv,[AC_DEFINE(HAVE_PUTENV,1,[have putenv call])],) +-AC_SUBST(HAVE_PUTENV) ++ AC_CHECK_FUNC(putenv,[AC_DEFINE(HAVE_PUTENV,1,[have putenv call])],) ++ AC_SUBST(HAVE_PUTENV) + fi + + AC_CHECK_FUNC(_cleanup, [AC_DEFINE(USE_CLEANUP,1,[have _cleanup function])],) + AC_SUBST(USE_CLEANUP) + gcl_ok=no + +-dnl AC_HEADER_EGREP(LITTLE_ENDIAN, ctype.h, gcl_ok=yes, gcl_ok=noo) +-dnl if test $gcl_ok = yes ; then +-dnl AC_DEFINE(ENDIAN_ALREADY_DEFINED) +-dnl fi +- +-dnl AC_SUBST(ENDIAN_ALREADY_DEFINED) +- +- +- +- +-# if test "x$enable_machine" = "x" ; then + AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O]) + + case $system in +- OSF*) ++ OSF*) + AC_DEFINE(USE_FIONBIO,1,[use fionbio for non-blocking io]) + AC_MSG_RESULT(FIONBIO) + ;; +@@ -2474,103 +1824,85 @@ esac + + + AC_MSG_CHECKING(check for SV_ONSTACK) +-AC_TRY_COMPILE([#include +-int joe=SV_ONSTACK; +-], +-[], +-[AC_DEFINE(HAVE_SV_ONSTACK,1,[have sv_onstack]) +- AC_SUBST(HAVE_SV_ONSTACK) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) ++AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ int joe=SV_ONSTACK; ++ ]], ++ [[]])], ++ [AC_DEFINE(HAVE_SV_ONSTACK,1,[have sv_onstack]) ++ AC_SUBST(HAVE_SV_ONSTACK) ++ AC_MSG_RESULT([yes])], ++ [AC_MSG_RESULT([no])]) + + AC_MSG_CHECKING(check for SIGSYS) +-AC_TRY_COMPILE([#include +-int joe=SIGSYS; +-], +-[], +-[AC_DEFINE(HAVE_SIGSYS,1,[have SIGSYS signal]) +- AC_SUBST(HAVE_SIGSYS) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) ++AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ int joe=SIGSYS; ++ ]],[[]])], ++ [AC_DEFINE(HAVE_SIGSYS,1,[have SIGSYS signal]) ++ AC_SUBST(HAVE_SIGSYS) ++ AC_MSG_RESULT([yes])], ++ [AC_MSG_RESULT([no])]) + + + AC_MSG_CHECKING(check for SIGEMT) +-AC_TRY_COMPILE([#include +-int joe=SIGEMT; +-], +-[], +-[AC_DEFINE(HAVE_SIGEMT,1,[have SIGEMT signal]) +- AC_SUBST(HAVE_SIGEMT) +- AC_MSG_RESULT(yes)], +-AC_MSG_RESULT(no)) ++AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ int joe=SIGEMT; ++ ]],[[]])], ++ [AC_DEFINE(HAVE_SIGEMT,1,[have SIGEMT signal]) ++ AC_SUBST(HAVE_SIGEMT) ++ AC_MSG_RESULT([yes])], ++ [AC_MSG_RESULT([no])]) + + AC_CHECK_FUNCS(sigaltstack) + AC_CHECK_FUNCS(feenableexcept) + + AC_CHECK_HEADERS(dis-asm.h, +- MLIBS=$LIBS +- AC_CHECK_LIB(opcodes,init_disassemble_info) +- AC_CHECK_LIB(dl,dlopen,#opcodes changes too quickly to link directly +- AC_CHECK_FUNCS(print_insn_i386,LIBS="$MLIBS -ldl"))) ++ MLIBS=$LIBS ++ AC_CHECK_LIB(opcodes,init_disassemble_info) ++ AC_CHECK_LIB(dl,dlopen,#opcodes changes too quickly to link directly ++ AC_CHECK_FUNCS(print_insn_i386,LIBS="$MLIBS -ldl"))) + + #if test $use = "386-linux" ; then +- AC_CHECK_HEADERS(asm/sigcontext.h) +- AC_CHECK_HEADERS(asm/signal.h) +- AC_MSG_CHECKING([for sigcontext...]) +- AC_TRY_COMPILE([#include +- ], +- [ +- struct sigcontext foo; +- ], +- [ +- sigcontext_works=1; +- AC_DEFINE(SIGNAL_H_HAS_SIGCONTEXT,1,[have sigcontext in signal.h]) +- AC_MSG_RESULT(sigcontext in signal.h) +- ], +- +- [sigcontext_works=0; +- AC_MSG_RESULT(sigcontext NOT in signal.h)] +- ) +- if test "$sigcontext_works" = 0 ; then +- AC_MSG_CHECKING([for sigcontext...]) +- AC_TRY_COMPILE([#include +- #ifdef HAVE_ASM_SIGCONTEXT_H +- #include +- #endif +- #ifdef HAVE_ASM_SIGNAL_H +- #include +- #endif +- ], +- [ +- struct sigcontext foo; +- ], +- [ +- AC_DEFINE(HAVE_SIGCONTEXT,1,[have sigcontext]) +- AC_MSG_RESULT(sigcontext in asm files) +- ], +- [ +- AC_MSG_RESULT(no sigcontext found) +- ]) +- +- +- fi +-# echo 'foo() {}' > conftest1.c +-# $CC -S conftest1.c +-# use_underscore=0 +-# if fgrep _foo conftest1.s ; then use_underscore=1 ; fi +-# if test $use_underscore = 0 ; then +-# MPI_FILE=mpi-386_no_under.o +-# else +-# MPI_FILE=mpi-386d.o +-# fi +-# AC_SUBST(MPI_FILE) +-# GCC=$CC +-# if test -x /usr/bin/i386-glibc20-linux-gcc ; then +-# GCC=/usr/bin/i386-glibc20-linux-gcc +-# fi +-# AC_SUBST(GCC) +- +-#fi ++AC_CHECK_HEADERS(asm/sigcontext.h) ++AC_CHECK_HEADERS(asm/signal.h) ++AC_MSG_CHECKING([for sigcontext...]) ++AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ ]], ++ [[ ++ struct sigcontext foo; ++ ]])], ++ [AC_DEFINE(SIGNAL_H_HAS_SIGCONTEXT,1,[have sigcontext of signal.h]) ++ AC_MSG_RESULT([sigcontext of signal.h])], ++ [AC_MSG_RESULT([sigcontext NOT of signal.h]) ++ AC_MSG_CHECKING([for sigcontext...]) ++ AC_COMPILE_IFELSE( ++ [AC_LANG_PROGRAM( ++ [[ ++ #include ++ #ifdef HAVE_ASM_SIGCONTEXT_H ++ #include ++ #endif ++ #ifdef HAVE_ASM_SIGNAL_H ++ #include ++ #endif ++ ]], ++ [[ ++ struct sigcontext foo; ++ ]])], ++ [AC_DEFINE(HAVE_SIGCONTEXT,1,[have sigcontext]) ++ AC_MSG_RESULT(sigcontext asm files)], ++ [AC_MSG_RESULT([no sigcontext found])])]) + + AC_PATH_PROG(EMACS,emacs) + +@@ -2590,11 +1922,11 @@ EOF + + AC_MSG_CHECKING([emacs site lisp directory]) + if [[ "$EMACS_SITE_LISP" = "unknown" ]] ; then +- if [[ "$EMACS" != "" ]] ; then +- EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` +- else +- EMACS_SITE_LISP="" +- fi ++ if [[ "$EMACS" != "" ]] ; then ++ EMACS_SITE_LISP=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++ else ++ EMACS_SITE_LISP="" ++ fi + fi + AC_MSG_RESULT($EMACS_SITE_LISP) + AC_SUBST(EMACS_SITE_LISP) +@@ -2613,14 +1945,14 @@ EOF + + AC_MSG_CHECKING([emacs default.el]) + if [[ "$EMACS" != "" ]] ; then +- EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` ++ EMACS_DEFAULT_EL=`$EMACS -q -batch --no-site-file -l conftest.el 2>&1 | sed -e /Loading/d | sed -e /load/d |sed -e /Warning:/d` + else +- EMACS_DEFAULT_EL="" ++ EMACS_DEFAULT_EL="" + fi + if test -f "${EMACS_DEFAULT_EL}" ; then true;else +- if test -d $EMACS_SITE_LISP ; then +- EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el +- fi ++ if test -d $EMACS_SITE_LISP ; then ++ EMACS_DEFAULT_EL=${EMACS_SITE_LISP}/default.el ++ fi + fi + AC_MSG_RESULT($EMACS_DEFAULT_EL) + AC_SUBST(EMACS_DEFAULT_EL) +@@ -2651,93 +1983,98 @@ fi + AC_MSG_RESULT($INFO_DIR) + AC_SUBST(INFO_DIR) + +-if test "$enable_tcltk" = "yes" ; then ++AC_ARG_ENABLE([tcltk],[ --enable-tcltk will try to build gcl-tk]) ++AC_ARG_ENABLE([tkconfig], ++ [ --enable-tkconfig=XXXX will force the use of a TK_CONFIG_PREFIX=XXXXX as place to look for tkConfig.sh and tclConfig.sh], ++ [TK_CONFIG_PREFIX=$enableval],[TK_CONFIG_PREFIX=unknown]) ++AC_ARG_ENABLE([tclconfig], ++ [ --enable-tclconfig=XXXX will force the use of a TCL_CONFIG_PREFIX=XXXXX as place to look for tclConfig.sh and tclConfig.sh], ++ [TCL_CONFIG_PREFIX=$enableval],[TCL_CONFIG_PREFIX=unknown]) + +- AC_MSG_CHECKING([for tcl/tk]) ++if test "$enable_tcltk" != "no" ; then + +- if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else ++ AC_MSG_CHECKING([for tcl/tk]) + +- AC_CHECK_PROG(TCLSH,tclsh,tclsh,${TCLSH}) +- +- if test "${TCLSH}" = "" ; then true ; else +- +- rm -f conftest.tcl +- cat >> conftest.tcl <> conftest.tcl <&1 $CC -v | fgrep "gcc version 2.96" > /dev/null +-dnl then +-dnl BROKEN_O4_OPT=1 +-dnl AC_DEFINE(BROKEN_O4_OPT) +-dnl AC_SUBST(BROKEN_O4_OPT) +-dnl echo ODIR_DEBUG=-O >> makedefsafter +-dnl echo >> makedefsafter +-dnl AC_MSG_RESULT([yes .. turning off -O4]) +-dnl else +-dnl AC_MSG_RESULT([no]) +-dnl fi +- +-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" ++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" + AC_SUBST(LDFLAGS) +-LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $TLDFLAGS $LIBS $TLIBS" ++LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + AC_SUBST(LIBS) +-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS $PROCESSOR_FLAGS" ++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" + AC_SUBST(FINAL_CFLAGS) + # Work around bug with gcc on ppc -- CM +-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" ++NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" + AC_SUBST(NIFLAGS) +-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS $PROCESSOR_FLAGS -I\$(GCLDIR)/o" ++CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" + AC_SUBST(CFLAGS) + O3FLAGS=$TO3FLAGS + AC_SUBST(O3FLAGS) + O2FLAGS=$TO2FLAGS + AC_SUBST(O2FLAGS) + +-AC_SUBST(PRELINK_CHECK) +- + AC_SUBST(EXTRA_LOBJS) + AC_SUBST(LEADING_UNDERSCORE) + AC_SUBST(GNU_LD) + if test -f h/$use.defs ; then +- +- AC_SUBST(use) +- AC_OUTPUT(makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp ) +- echo makedefc +- cat makedefc +- +- echo add-defs1 $use +- CC=$CC ./add-defs1 $use +- ++ ++ AC_SUBST(use) ++ AC_OUTPUT(makedefc windows/gcl.iss windows/sysdir.bat windows/install.lsp ) ++ echo makedefc ++ cat makedefc ++ ++ echo add-defs1 $use ++ CC=$CC ./add-defs1 $use ++ + else +- echo "Unable to guess machine type" +- echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs ++ echo "Unable to guess machine type" ++ echo use configure --enable-machine=XXX, for XXX such that h/XXX.defs exists, ie in h/*.defs + fi +--- gcl-2.6.12.orig/gcl-tk/sheader.h ++++ gcl-2.6.12/gcl-tk/sheader.h +@@ -45,7 +45,7 @@ struct message_header { + + + #define BYTE_S 8 +-#define BYTE_MASK (~(~0 << BYTE_S)) ++#define BYTE_MASK (~(~0UL << BYTE_S)) + + #define GET_3BYTES(p,ans) do{ unsigned char* __p = (unsigned char *) p; \ + ans = BYTE_MASK&(*__p++); \ +--- gcl-2.6.12.orig/h/compprotos.h ++++ gcl-2.6.12/h/compprotos.h +@@ -170,6 +170,7 @@ int gcl_putc(int,void *); + #ifdef CMPINCLUDE + int setjmp(); + int _setjmp(); ++int _setjmp3(); + #endif + void vfun_wrong_number_of_args(object); + void ihs_overflow (void); +@@ -179,4 +180,3 @@ char *gcl_gets(char *,int); + int gcl_puts(const char *); + int endp_error(object); + object Icall_gen_error_handler(object,object,object,object,ufixnum,...); +- +--- gcl-2.6.12.orig/h/funlink.h ++++ gcl-2.6.12/h/funlink.h +@@ -54,7 +54,7 @@ enum F_arg_types + }; + + /* Make a mask for bits i < j, masking j-i bits */ +-#define MASK_RANGE(i,j) ((~(~0 << (j-i)))<< i) ++#define MASK_RANGE(i,j) ((~(~0UL << (j-i)))<< i) + + #define F_PLAIN(x) (((x) & MASK_RANGE( F_START_TYPES_POS,31)) == 0) + #define ARG_LIMIT 63 +--- gcl-2.6.12.orig/h/mingw.defs ++++ gcl-2.6.12/h/mingw.defs +@@ -54,7 +54,7 @@ TCL_LIB_SPEC= + TCL_DL_LIBS= + TCL_LIBS= + +-PWD_CMD=pwd -W ++#PWD_CMD=pwd -W + + # + # End h/mingw.defs +--- gcl-2.6.12.orig/h/mingw.h ++++ gcl-2.6.12/h/mingw.h +@@ -26,21 +26,6 @@ + #define f_nsyms NumberOfSymbols + #define NO_PWD_H + +-#define MAXPATHLEN 512 +- +-/* alter pathToAlter to fit in with the Clibrary of the system. +- and report error using name 'x' if you cant do it. +- The result in pathToAlter should be less +-*/ +-#define FIX_FILENAME(x,pathToAlter) fix_filename(x,pathToAlter) +- +-#define MEMORY_SAVE(self,filename) \ +- do { char buf[MAXPATHLEN]; \ +- strcpy(buf,self); \ +- fix_filename(Cnil,buf); \ +- memory_save(buf,filename); \ +- } while (0) +- + #define signals_pending *signalsPendingPtr + + #undef DBEGIN_TY +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -371,6 +371,9 @@ emsg(const char *s,...) { + va_list args; + ufixnum n=0; + void *v=NULL; ++#ifndef vsnprintf ++ extern int vsnprintf(); ++#endif + va_start(args,s); + n=vsnprintf(v,n,s,args)+1; + va_end(args); +--- gcl-2.6.12.orig/h/protoize.h ++++ gcl-2.6.12/h/protoize.h +@@ -1777,6 +1777,7 @@ void gcl_init_shared_memory ( void ); + void fix_filename ( object pathname, char *filename1 ); + void alarm ( int n ); + void *sbrk ( ptrdiff_t increment ); ++#define sigset_t int + void sigemptyset( sigset_t *set); + void sigaddset ( sigset_t *set, int n); + int sigismember ( sigset_t *set, int n ); +@@ -1798,19 +1799,12 @@ msystem(const char *); + void + assert_error(const char *,unsigned,const char *,const char *); + +-#ifdef _WIN32 +-void +-detect_wine(void); +- ++#ifdef __MINGW32__ + void + init_shared_memory(void); + +-void * +-alloca(size_t); +- + object + find_init_string(const char *); +- + #endif + + void * +@@ -1964,3 +1958,6 @@ gcl_cleanup(int); + + void + do_gcl_abort(void); ++ ++int ++vsystem(const char *); +--- gcl-2.6.12.orig/h/wincoff.h ++++ gcl-2.6.12/h/wincoff.h +@@ -10,6 +10,7 @@ + in this */ + #undef va_start + ++#include "winsock2.h" + #include "windows.h" + #ifdef __MINGW32__ + #include "minglacks.h" +--- gcl-2.6.12.orig/lsp/gcl_auto_new.lsp ++++ gcl-2.6.12/lsp/gcl_auto_new.lsp +@@ -206,14 +206,8 @@ + ;; So to stop users from invoking this + #+sun + (defun user-homedir-pathname () +- (let* ((tem (si::getenv "HOME")) +- (l (- (length tem) 1))) +- (cond ((null tem) nil) +- (t +- (or (and (>= l 0) +- (eql (aref tem l) #\/)) +- (setq tem (concatenate 'string tem "/"))) +- (pathname tem))))) +- ++ (let* ((tem (si::getenv "HOME"))) ++ (when tem ++ (pathname (coerce-slash-terminated tem))))) + + (AUTOLOAD 'init-readline '|gcl_readline|) +--- gcl-2.6.12.orig/lsp/gcl_directory.lsp ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -34,9 +34,9 @@ + (defun make-frame (s &aux (l (length s))) + (replace (make-array l :element-type 'character :adjustable t :fill-pointer l) s)) + +-(defun expand-wild-directory (l f zz &optional (yy (make-frame zz))) ++(defun expand-wild-directory (d l f zz &optional (yy (make-frame zz))) + (let* ((x (member-if 'wild-dir-element-p l)) +- (s (namestring (make-pathname :directory (ldiff l x)))) ++ (s (namestring (make-pathname :device d :directory (ldiff l x)))) + (z (vector-push-string zz s)) + (l (length yy)) + (y (link-expand (vector-push-string yy s) l)) +@@ -45,19 +45,15 @@ + (cond ((eq (car x) :wild-inferiors) (recurse-dir z y f)) + (x (walk-dir z y (lambda (q e l) + (declare (ignore l)) +- (expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME ++ (expand-wild-directory d (cons :relative (cdr x)) f q e)) :directory));FIXME + ((funcall f z y)))))) + +-(defun chdir (s) +- (when (chdir1 (namestring (pathname s)));to expand ~/ +- (setq *current-directory* (current-directory-pathname)))) +- + (defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) + (c (unless (eq (car d) :absolute) (make-frame (namestring *current-directory*)))) + (lc (when c (length c))) + (filesp (or (pathname-name p) (pathname-type p))) + (v (compile-regexp (to-regexp p)))(*up-key* :back) r) +- (expand-wild-directory d ++ (expand-wild-directory (pathname-device p) d + (lambda (dir exp &aux (pexp (pathname (if c (vector-push-string c exp 0 lc) exp)))) + (if filesp + (walk-dir dir exp +@@ -67,5 +63,15 @@ + (push (merge-pathnames (parse-namestring dir nil *default-pathname-defaults* :start pos) pexp nil) r))) + :file) + (when (pathname-match-p dir v) (push pexp r)))) +- (make-frame (if c "./" ""))) ++ (make-frame "")) + r) ++ ++(defun chdir (s) ++ (when (chdir1 (namestring (pathname s)));to expand ~/ ++ (setq *current-directory* (current-directory-pathname)))) ++ ++(defun which (s) ++ (let ((r (with-open-file (s (apply 'string-concatenate "|" #-winnt "which " ++ #+winnt "for %i in (" s #+winnt ".exe) do @echo.%~$PATH:i" nil)) ++ (read-line s nil 'eof)))) ++ (if (eq r 'eof) s (string-downcase r)))) +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -451,7 +451,7 @@ + (let* ((*load-pathname* pp)(*load-truename* epp)) + (with-open-file + (s epp :external-format external-format) +- (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xfe #xff #x4c))) ++ (if (member (peek-char nil s nil 'eof) '#.(mapcar 'code-char (list 127 #xcf #xce #x4c))) + (load-fasl s print) + (let ((*standard-input* s)) (load-stream s print))))) + (when if-does-not-exist +--- gcl-2.6.12.orig/lsp/gcl_make_pathname.lsp ++++ gcl-2.6.12/lsp/gcl_make_pathname.lsp +@@ -4,29 +4,58 @@ + ;; (declare (optimize (safety 1))) + ;; (when (typep x 'pathname) t)) + ++ ++(eval-when (compile eval) ++ (defun add-dir-sep (s &optional (i 0) (bp 0) (l (length s))) ++ (when (< i l) ++ (let ((x (aref s i))) ++ (append ++ (if (eql x #\/) ++ (if (zerop bp) (list #\[ x #\\ #\]) (list x #\\)) ++ (list x)) ++ (add-dir-sep s (1+ i) (case x (#\[ (1+ bp))(#\] (1- bp))(otherwise bp)) l))))) ++ ++ (defun ads (s) #+winnt (coerce (add-dir-sep s) 'string) #-winnt s)) ++ ++(defconstant +dirsep+ (compile-regexp #.(ads "/"))) ++ ++(defconstant +glob-to-regexp-alist+ (list (cons #v"{[^}]*}" (lambda (x) (msub '((#\| . #\,)(#\( . #\{)(#\) . #\})) x))) ++ (cons #v"\\[[^\\]*\\]" ++ (lambda (x) ++ (string-concatenate "(" (substitute #\^ #\! (subseq x 0 2)) (subseq x 2) ")"))) ++ (cons #v"\\*" (lambda (x) #.(ads "([^/.]*)"))) ++ (cons #v"\\?" (lambda (x) #.(ads "([^/.])"))) ++ (cons #v"\\." (lambda (x) "\\.")))) ++ ++(defconstant +physical-pathname-defaults+ '(("" "" "") ++ #+winnt("" "([A-Za-z]:)?" ":") #-winnt("" "()" "") ++ ("" #.(ads "(/?([^/]+/)*)") "" "" #.(ads "([^/]+/)") "/") ++ ("" #.(ads "([^/.]*)") "") ++ ("." #.(ads "(\\.[^/]*)?") "") ++ ("" "" ""))) ++ ++(defconstant +logical-pathname-defaults+ '(("" "([-0-9A-Z]+:)?" ":") ++ ("" "" "") ++ ("" "(;?((\\*?([-0-9A-Z]+\\*?)+|\\*|\\*\\*);)*)" "" "" "((\\*?([-0-9A-Z]+\\*?)+|\\*);)" ";") ++ ("" "(\\*?([-0-9A-Z]+\\*?)+|\\*)?" "") ++ ("." "(\\.(\\*?([-0-9A-Z]+\\*?)+|\\*))?" "") ++ ("." "(\\.([1-9][0-9]*|newest|NEWEST|\\*))?" ""))) ++ + (defun msub (a x) (if a (msub (cdr a) (substitute (caar a) (cdar a) x)) x)) + +-(defvar *glob-to-regexp-alist* (list (cons #v"{[^}]*}" (lambda (x) (msub '((#\| . #\,)(#\( . #\{)(#\) . #\})) x))) +- (cons #v"\\[[^\\]*\\]" (lambda (x) +- (concatenate 'string "(" +- (substitute #\^ #\! (subseq x 0 2)) +- (subseq x 2) ")"))) +- (cons #v"\\*" (lambda (x) "([^/.]*)")) +- (cons #v"\\?" (lambda (x) "([^/.])")) +- (cons #v"\\." (lambda (x) "\\.")))) + + (defun mglist (x &optional (b 0)) + (let* ((y (mapcan (lambda (z &aux (w (string-match (car z) x b))) + (unless (eql w -1) + (list (list w (match-end 0) z)))) +- *glob-to-regexp-alist*)) ++ +glob-to-regexp-alist+)) + (z (when y (reduce (lambda (y x) (if (< (car x) (car y)) x y)) y)))) + (when z + (cons z (mglist x (cadr z)))))) + + (defun mgsub (x &optional (l (mglist x)) (b 0) &aux (w (pop l))) + (if w +- (concatenate 'string ++ (string-concatenate + (subseq x b (car w)) + (funcall (cdaddr w) (subseq x (car w) (cadr w))) + (mgsub x l (cadr w))) +@@ -49,21 +78,10 @@ + ; ) + ) + +-(defconstant +physical-pathname-defaults+ '(("" "" "") +- ("" "" "") +- ("" "(/?([^/]+/)*)" "" "" "([^/]+/)" "/") +- ("" "([^/.]*)" "") +- ("." "(\\.[^/]*)?" "") +- ("" "" ""))) +-(defconstant +logical-pathname-defaults+ '(("" "([-0-9A-Z]+:)?" ":") +- ("" "" "") +- ("" "(;?((\\*?([-0-9A-Z]+\\*?)+|\\*|\\*\\*);)*)" "" "" "((\\*?([-0-9A-Z]+\\*?)+|\\*);)" ";") +- ("" "(\\*?([-0-9A-Z]+\\*?)+|\\*)?" "") +- ("." "(\\.(\\*?([-0-9A-Z]+\\*?)+|\\*))?" "") +- ("." "(\\.([1-9][0-9]*|newest|NEWEST|\\*))?" ""))) ++ + + (defun to-regexp-or-namestring (x rp lp) +- (apply 'concatenate 'string ++ (apply 'string-concatenate + (mapcan (lambda (x y) (elsub x y rp lp)) + x (if lp +logical-pathname-defaults+ +physical-pathname-defaults+)))) + +@@ -101,14 +119,14 @@ + (eval-when (compile eval) + (defun strsym (p &rest r) + (declare (:dynamic-extent r)) +- (intern (apply 'concatenate 'string (mapcar 'string-upcase r)) p))) ++ (intern (apply 'string-concatenate (mapcar 'string-upcase r)) p))) + + #.`(defun make-pathname (&key (host nil hostp) (device nil devicep) (directory nil directoryp) + (name nil namep) (type nil typep) (version nil versionp) + defaults (case :local) namestring &aux defaulted (def (when defaults (pathname defaults)))) + (declare (optimize (safety 1))) + (check-type host (or (member nil :unspecific) string)) +- (check-type device (member nil :unspecific)) ++ (check-type device (or (member nil :unspecific) string)) + (check-type directory (or (member nil :unspecific :wild) string list)) + (check-type name (or string (member nil :unspecific :wild))) + (check-type type (or string (member nil :unspecific :wild))) +@@ -116,7 +134,8 @@ + (check-type defaults (or null pathname-designator)) + (check-type case (member :common :local)) + ,(flet ((def? (k) `(let* (,@(when (eq k 'host) `((def (or def *default-pathname-defaults*)))) +- (nk (if ,(strsym :si k "P") ,k (progn (setq defaulted t) (when def (,(strsym :si "C-PATHNAME-" k) def))))) ++ (nk (if ,(strsym :si k "P") ,k (when def (,(strsym :si "C-PATHNAME-" k) def)))) ++ (nk (progn (unless (eq ,k nk) (setq defaulted t)) nk)) + (nk (if (eq case :local) nk (progn (setq defaulted t) (toggle-case nk))))) + nk))) + `(let* ((h ,(def? 'host)) +--- gcl-2.6.12.orig/lsp/gcl_parse_namestring.lsp ++++ gcl-2.6.12/lsp/gcl_parse_namestring.lsp +@@ -14,6 +14,7 @@ + (defun dir-conj (x) (if (eq x :relative) :absolute :relative)) + + (defvar *up-key* :up) ++(defvar *canonicalized* nil) + + (defun mfr (x b i) (subseq x b i)); (make-array (- i b) :element-type 'character :displaced-to x :displaced-index-offset b) + +@@ -30,15 +31,15 @@ + (z (if w (cdr w) z))) + (if (eq z :up) *up-key* z))) + +-(defun dir-parse (x sep sepfirst &optional (b 0)) ++(defun dir-parse (x &optional lp (b 0)) + (when (stringp x) +- (let ((i (search sep x :start2 b)));string-match spoils outer match results +- (when i +- (let* ((y (dir-parse x sep sepfirst (1+ i))) ++ (let ((i (string-match (if lp #v";" +dirsep+) x b))) ++ (unless (minusp i) ++ (let* ((y (dir-parse x lp (1+ i))) + (z (element x b i :directory)) +- (y (if z (cons z y) y))) ++ (y (if z (cons z y) (progn (when (> i b) (setq *canonicalized* t)) y)))) + (if (zerop b) +- (cons (if (zerop i) sepfirst (dir-conj sepfirst)) y) ++ (cons (if (if lp (plusp i) (zerop i)) :absolute :relative) y) + y)))))) + + (defun match-component (x i k &optional (boff 0) (eoff 0)) +@@ -52,40 +53,37 @@ + + (defconstant +generic-logical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +logical-pathname-defaults+)) t t))) + +-(defun expand-home-dir (dir) +- (cond ((and (eq (car dir) :relative) (stringp (cadr dir)) (eql #\~ (aref (cadr dir) 0))) +- (append (dir-parse (home-namestring (cadr dir)) "/" :absolute) (cddr dir))) +- (dir))) +- + (defun logical-pathname-parse (x &optional host def (b 0) (e (length x))) +- (when (and (eql b (string-match +generic-logical-pathname-regexp+ x b e)) (eql (match-end 0) e)) +- (let ((mhost (match-component x 1 :host 0 -1))) +- (when (and host mhost) +- (unless (string-equal host mhost) ++ (when *pathname-logical* ;;accelerator ++ (when (and (eql b (string-match +generic-logical-pathname-regexp+ x b e)) (eql (match-end 0) e)) ++ (let ((mhost (match-component x 1 :host 0 -1))) ++ (when (and host mhost) ++ (unless (string-equal host mhost) + (error 'error :format-control "Host part of ~s does not match ~s" :format-arguments (list x host)))) +- (let ((host (or host mhost (pathname-host def)))) +- (when (logical-pathname-host-p host) +- (let* ((dir (dir-parse (match-component x 2 :none) ";" :relative)) +- (edir (expand-home-dir dir))) +- (make-pathname :host host +- :device :unspecific +- :directory edir +- :name (match-component x 6 :name) +- :type (match-component x 8 :type 1) +- :version (version-parse (match-component x 11 :version 1)) +- :namestring (when (and mhost (eql b 0) (eql e (length x)) (eq dir edir)) x)))))))) +- ++ (let ((host (or host mhost (pathname-host def)))) ++ (when (logical-pathname-host-p host) ++ (make-pathname :host host ++ :device :unspecific ++ :name (match-component x 6 :name) ++ :type (match-component x 8 :type 1) ++ :version (version-parse (match-component x 11 :version 1)) ++ :directory (dir-parse (match-component x 2 :none) t);must be last ++ :namestring (when (and mhost (eql b 0) (eql e (length x))) x)))))))) ++ + (defconstant +generic-physical-pathname-regexp+ (compile-regexp (to-regexp-or-namestring (make-list (length +physical-pathname-defaults+)) t nil))) + +-(defun pathname-parse (x b e) +- (when (and (eql b (string-match +generic-physical-pathname-regexp+ x b e)) (eql (match-end 0) e)) +- (let* ((dir (dir-parse (match-component x 1 :none) "/" :absolute)) +- (edir (expand-home-dir dir))) +- (make-pathname :directory edir +- :name (match-component x 3 :name) +- :type (match-component x 4 :type 1) +- :namestring (when (and (eql b 0) (eql e (length x)) (eq dir edir)) x))))) ++(defun expand-home-dir (dir) ++ (if (and (eq (car dir) :relative) (stringp (cadr dir)) (eql #\~ (aref (cadr dir) 0))) ++ (prog1 (append (dir-parse (home-namestring (cadr dir))) (cddr dir)) (setq *canonicalized* t)) ++ dir)) + ++(defun pathname-parse (x b e &aux (*canonicalized* nil)) ++ (when (and (eql b (string-match +generic-physical-pathname-regexp+ x b e)) (eql (match-end 0) e)) ++ (make-pathname :device (match-component x 1 :none 0 -1) ++ :name (match-component x 4 :name) ++ :type (match-component x 5 :type 1) ++ :directory (expand-home-dir (dir-parse (match-component x 2 :none)));must be last ++ :namestring (unless *canonicalized* (when (and (eql b 0) (eql e (length x))) x))))) + + (defun path-stream-name (x) + (check-type x pathname-designator) +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -581,27 +581,20 @@ First directory is checked for first nam + + (defvar *tmp-dir*) + +-(defun wine-tmp-redirect () +- (let* ((s (find-symbol "*WINE-DETECTED*" (find-package "SYSTEM")))) +- (when (and s (symbol-value s)) +- (list *system-directory*)))) +- + (defun ensure-dir-string (str) + (if (eq (stat str) :directory) + (coerce-slash-terminated str) + str)) + + (defun get-temp-dir () +- (dolist (x `(,@(wine-tmp-redirect) ,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) ++ (dolist (x `(,@(mapcar 'si::getenv '("TMPDIR" "TMP" "TEMP")) "/tmp" "")) + (when x + (let ((x (coerce-slash-terminated x))) + (when (eq (stat x) :directory) + (return-from get-temp-dir x)))))) + +-(defun get-path (s &aux (m (string-match "([^/ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1)) +- (r (with-open-file (s (concatenate 'string "|which " (subseq s b e))) (read s nil 'eof)))) +- (if (eq r 'eof) s (concatenate 'string (string-downcase r) (subseq s e)))) +- ++(defun get-path (s &aux (m (string-match "([^ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1))) ++ (string-concatenate (which (pathname-name (subseq s b e))) (subseq s e))) + + (defvar *cc* "cc") + (defvar *ld* "ld") +@@ -609,7 +602,7 @@ First directory is checked for first nam + + (defvar *current-directory* *system-directory*) + +-(defun current-directory-pathname nil (pathname (concatenate 'string (getcwd) "/"))) ++(defun current-directory-pathname nil (pathname (coerce-slash-terminated (getcwd)))) + + (defun set-up-top-level (&aux (i (argc)) tem) + (declare (fixnum i)) +@@ -627,9 +620,7 @@ First directory is checked for first nam + (when dir + (setq *lib-directory* (coerce-slash-terminated dir))))) + (unless (and *load-path* (equal tem *lib-directory*)) +- (setq *load-path* (cons (string-concatenate *lib-directory* "lsp/") *load-path*)) +- (setq *load-path* (cons (string-concatenate *lib-directory* "gcl-tk/") *load-path*)) +- (setq *load-path* (cons (string-concatenate *lib-directory* "xgcl-2/") *load-path*))) ++ (mapc (lambda (x) (push (string-concatenate *lib-directory* x) *load-path*)) '("lsp/" "gcl-tk/" "xgcl-2/"))) + (unless (boundp '*system-directory*) + (setq *system-directory* (namestring (truename (make-pathname :name nil :type nil :defaults (argv 0)))))))) + +--- gcl-2.6.12.orig/lsp/gcl_truename.lsp ++++ gcl-2.6.12/lsp/gcl_truename.lsp +@@ -4,11 +4,11 @@ + (labels ((frame (b e) (make-array (- n b) :element-type 'character + :displaced-to str :displaced-index-offset b :fill-pointer (- e b))) + (set-fr (fr e &aux (fr (or fr (frame 0 b)))) (setf (fill-pointer fr) e) fr)) +- (let* ((i (string-match #v"/" str b)) ++ (let* ((i (string-match +dirsep+ str b)) + (fr (set-fr fr (if (eql i -1) n i))) + (l (when (eq (stat fr) :link) (readlinkat 0 fr)))) + (cond (l (let ((b (if (eql #\/ (aref l 0)) 0 b))) +- (link-expand (concatenate 'string (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) ++ (link-expand (string-concatenate (set-fr fr b) l (frame (if (eql i -1) n i) n)) b))) + ((eql i -1) str) + ((link-expand str (1+ i) n fr)))))) + +--- gcl-2.6.12.orig/makedefc.in ++++ gcl-2.6.12/makedefc.in +@@ -45,6 +45,7 @@ PRELINK_CHECK=@PRELINK_CHECK@ + + NOTIFY=@NOTIFY@ + CC=@CC@ ++GCL_CC=@GCL_CC@ + CFLAGS=@CFLAGS@ + LDFLAGS=@LDFLAGS@ + FINAL_CFLAGS=@FINAL_CFLAGS@ +--- gcl-2.6.12.orig/o/bind.c ++++ gcl-2.6.12/o/bind.c +@@ -23,6 +23,8 @@ Foundation, 675 Mass Ave, Cambridge, MA + bind.c + */ + ++#include ++ + #include "include.h" + + static void +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -149,7 +149,7 @@ enum dump_type { + + /* given SHORT extract top code (say 4 bits) and bottom byte */ + #define TOP(i) (i >> SIZE_BYTE) +-#define BOTTOM(i) (i & ~(~0 << SIZE_BYTE)) ++#define BOTTOM(i) (i & ~(~0UL << SIZE_BYTE)) + + #define FASD_VERSION 2 + +@@ -328,7 +328,7 @@ getd(str) + + + #define D_TYPE_OF(byt) \ +- ((enum dump_type )((unsigned int) byt & ~(~0 << SIZE_D_CODE))) ++ ((enum dump_type )((unsigned int) byt & ~(~0UL << SIZE_D_CODE))) + + /* this field may be the top of a short for length, or part of an extended + code */ +@@ -379,7 +379,7 @@ getd(str) + + + +-#define MASK ~(~0 << 8) ++#define MASK ~(~0UL << 8) + #define WRITE_BYTEI(x,i) putc((((x) >> (i*SIZE_BYTE)) & MASK),fas_stream) + + #define PUTFIX(v_) Join(PUT,SIZEOF_LONG)(v_) +@@ -398,7 +398,7 @@ getd(str) + WRITE_BYTEI(var,7);} while(0) + + #define PUT4(varx ) \ +- do{int var= varx ; \ ++ do{unsigned long var= varx ; \ + DPRINTF("{4byte:varx= %d}", var); \ + WRITE_BYTEI(var,0); \ + WRITE_BYTEI(var,1); \ +@@ -406,14 +406,14 @@ getd(str) + WRITE_BYTEI(var,3);} while(0) + + #define PUT2(var ) \ +- do{int v=var; \ ++ do{unsigned long v=var; \ + DPRINTF("{2byte:var= %d}", v); \ + WRITE_BYTEI(v,0); \ + WRITE_BYTEI(v,1); \ + } while(0) + + #define PUT3(var ) \ +- do{int v=var; \ ++ do{unsigned long v=var; \ + DPRINTF("{3byte:var= %d}", v); \ + WRITE_BYTEI(v,0); \ + WRITE_BYTEI(v,1); \ +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -89,8 +89,8 @@ Foundation, 675 Mass Ave, Cambridge, MA + # include + # include + #else +-# include + # include ++# include + #endif + #include + +@@ -400,7 +400,8 @@ open_stream(object fn,enum smmode smm, o + fclose(fp); + if (if_exists==sKerror) FILE_ERROR(fn,"File exists"); + else if (if_exists==sKrename) { +- massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0); ++ massert(snprintf(FN2,sizeof(FN2),"%-*.*s~",(int)strlen(FN1)-1,(int)strlen(FN1)-1,FN1)>=0); ++ massert(!unlink(FN2));/*MinGW*/ + massert(!rename(FN1,FN2)); + if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); + } else if (if_exists==sKrename_and_delete || +--- gcl-2.6.12.orig/o/funlink.c ++++ gcl-2.6.12/o/funlink.c +@@ -322,10 +322,11 @@ call_proc(object sym, void **link, int a + + } else if (type_of(fun)==t_afun) { + +- ufixnum at=F_TYPES(fun->sfn.sfn_argd)>>F_TYPE_WIDTH; +- ufixnum ma=F_MIN_ARGS(fun->sfn.sfn_argd); +- ufixnum xa=F_MAX_ARGS(fun->sfn.sfn_argd); +- ufixnum rt=F_RESULT_TYPE(fun->sfn.sfn_argd); ++ ufixnum ad=fun->sfn.sfn_argd; ++ ufixnum at=F_TYPES(ad)>>F_TYPE_WIDTH; ++ ufixnum ma=F_MIN_ARGS(ad); ++ ufixnum xa=F_MAX_ARGS(ad); ++ ufixnum rt=F_RESULT_TYPE(ad); + + nargs=SFUN_NARGS(argd); + if (nargs xa || ((argd>>8)&0x3)!=rt || (argd>>12)!=at) +--- gcl-2.6.12.orig/o/hash.d ++++ gcl-2.6.12/o/hash.d +@@ -48,7 +48,7 @@ typedef unsigned char uchar; + + static ufixnum rtb[256]; + +-#define MASK(n) (~(~0L << (n))) ++#define MASK(n) (~(~0UL << (n))) + + static ufixnum + ufixhash(ufixnum g) { +--- gcl-2.6.12.orig/o/main.c ++++ gcl-2.6.12/o/main.c +@@ -148,7 +148,7 @@ mbrk(void *v) { + + #if defined(__CYGWIN__)||defined(__MINGW32__) + +-#include ++#include + + static ufixnum + get_phys_pages_no_malloc(char n) { +@@ -470,12 +470,6 @@ main(int argc, char **argv, char **envp) + kcl_self = argv[0]; + #endif + +-#ifdef __MINGW32__ +- { +- char *s=kcl_self; +- for (;*s;s++) if (*s=='\\') *s='/'; +- } +-#endif + *argv=kcl_self; + + #ifdef CAN_UNRANDOMIZE_SBRK +@@ -537,10 +531,6 @@ main(int argc, char **argv, char **envp) + + } + +-#ifdef _WIN32 +- detect_wine(); +-#endif +- + sSAlisp_maxpagesA->s.s_dbind = make_fixnum(real_maxpage); + + ihs_push(Cnil); +--- gcl-2.6.12.orig/o/mingfile.c ++++ gcl-2.6.12/o/mingfile.c +@@ -1,57 +1,6 @@ + #include "include.h" +-#include "windows.h" + #include "winsock2.h" +- +-extern object truename(object); +-extern object make_pathname(); +-void Ldirectory ( void ) +-{ +- char filename[MAXPATHLEN]; +- object *top=vs_top; +- object path; +- check_arg(1); +- check_type_or_pathname_string_symbol_stream(&vs_base[0]); +- path = vs_base[0] = coerce_to_pathname(vs_base[0]); +- +- if (vs_base[0]->pn.pn_name==Cnil && vs_base[0]->pn.pn_type==Cnil) { +- coerce_to_filename(vs_base[0], filename); +- strcat(filename, "*.*"); +- } else if (vs_base[0]->pn.pn_name==Cnil) { +- vs_base[0]->pn.pn_name = sKwild; +- coerce_to_filename(vs_base[0], filename); +- vs_base[0]->pn.pn_name = Cnil; +- } else if (vs_base[0]->pn.pn_type==Cnil) { +- coerce_to_filename(vs_base[0], filename); +- strcat(filename, ".*"); +- } else +- coerce_to_filename(vs_base[0], filename); +- { WIN32_FIND_DATA data; +- HANDLE dirHandle = FindFirstFile(filename,&data); +- +- if (dirHandle== INVALID_HANDLE_VALUE) { +- vs_base[0]=Cnil; return; +- } else { +- do { +- if (strcmp(data.cFileName,"..") != 0 && strcmp(data.cFileName,".") != 0 ) { +- object name = make_simple_string(data.cFileName); +- object new = coerce_to_pathname(name); +- vs_push(make_pathname(path->pn.pn_host, +- path->pn.pn_device, +- path->pn.pn_directory, +- new->pn.pn_name, +- new->pn.pn_type, +- new->pn.pn_version)); +- } +- } while (FindNextFile(dirHandle,&data)); +- FindClose(dirHandle); +- } +- vs_push(Cnil); +- while (vs_top > top + 1) +- stack_cons(); +- vs_base = top; +- +- } +-} ++#include "windows.h" + + int + mingwlisten(FILE *fp) { +--- gcl-2.6.12.orig/o/mingwin.c ++++ gcl-2.6.12/o/mingwin.c +@@ -2,6 +2,7 @@ + + + ++#include "winsock2.h" + #include "windows.h" + #include "errno.h" + #include "signal.h" +@@ -923,20 +924,6 @@ sigprocmask (int how , const sigset_t *s + return 0; + } + +-void +-fix_filename(object pathname, char *filename1) { +- +- char *filename=filename1,*p=filename; +- extern char *getwd(); +- +- while (*p) { +- if (*p=='\\') *p='/'; +- p++; +- } +- +-} +- +- + char *GCLExeName ( void ) + { + static char module_name_buf[128]; +@@ -948,3 +935,35 @@ char *GCLExeName ( void ) + } + return ( (char *) rv ); + } ++ ++int ++vsystem(const char *command) { ++ ++ STARTUPINFO s={0}; ++ PROCESS_INFORMATION p={0}; ++ long unsigned int e; ++ char *cmd=NULL,*r; ++ ++ if (!strpbrk(command,"\"'$<>")) { ++ ++ cmd=FN1; ++ massert((r=strpbrk(command," \n\t"))-command=0); ++ command=FN1; ++ ++ } ++ ++ massert(CreateProcess(cmd,(void *)command,NULL,NULL,FALSE,NORMAL_PRIORITY_CLASS|CREATE_NO_WINDOW,NULL,NULL,&s,&p)); ++ massert(!WaitForSingleObject(p.hProcess,INFINITE)); ++ massert(GetExitCodeProcess(p.hProcess,&e)); ++ massert(CloseHandle(p.hProcess)); ++ massert(CloseHandle(p.hThread)); ++ ++ return e; ++ ++} +--- gcl-2.6.12.orig/o/sfaslcoff.c ++++ gcl-2.6.12/o/sfaslcoff.c +@@ -47,7 +47,16 @@ struct scnhdr { + #define ALLOC_SEC(sec) (sec->s_flags&(SEC_CODE|SEC_DATA|SEC_BSS)) + #define LOAD_SEC(sec) (sec->s_flags&(SEC_CODE|SEC_DATA)) + +-#define STOP(s_,op_) ({char *_s=s_,_c=_s[8];_s[8]=0;op_;_s[8]=_c;}) ++#define NM(sym_,tab_,nm_,op_) \ ++ ({char _c=0,*nm_; \ ++ if ((sym_)->n.n.n_zeroes) \ ++ {(nm_)=(sym_)->n.n_name;_c=(nm_)[8];(nm_)[8]=0;} \ ++ else \ ++ (nm_)=(tab_)+(sym_)->n.n.n_offset; \ ++ op_; \ ++ if (_c) (nm_)[8]=_c; \ ++ }) ++ + + struct reloc { + union { +@@ -164,7 +173,7 @@ get_sym_value(const char *name) { + static void + relocate_symbols(struct syment *sym,struct syment *sye,struct scnhdr *sec1,char *st1) { + +- struct node *answ; ++ long value; + + for (;symn_scnum) { + +- if (sym->n.n.n_zeroes) +- STOP(sym->n.n_name,sym->n_value=get_sym_value(sym->n.n_name)); +- else +- sym->n_value=get_sym_value(st1+sym->n.n.n_offset); ++ NM(sym,st1,s,value=get_sym_value(s)); ++ ++ sym->n_value=value; + + } + +@@ -256,10 +264,7 @@ load_self_symbols() { + + ns++; + +- if (sym->n.n.n_zeroes) +- STOP(sym->n.n_name,sl+=strlen(sym->n.n_name)+1); +- else +- sl+=strlen(st1+sym->n.n.n_offset)+1; ++ NM(sym,st1,s,sl+=strlen(s)+1); + + sym+=sym->n_numaux; + +@@ -274,10 +279,7 @@ load_self_symbols() { + if (sym->n_sclass!=2 || sym->n_scnum<1) + continue; + +- if (sym->n.n.n_zeroes) +- STOP(sym->n.n_name,strcpy(st,sym->n.n_name)); +- else +- strcpy(st,st1+sym->n.n.n_offset); ++ NM(sym,st1,s,strcpy(st,s)); + + sec=sec1+sym->n_scnum-1; + jj=sym->n_value+sec->s_vaddr+h->h_ibase; +@@ -343,7 +345,7 @@ find_init_string(const char *s) { + struct syment *sy1,*sym,*sye; + char *st1,*ste; + void *st,*est; +- object o; ++ object o=OBJNULL; + + massert(f=fopen(s,"r")); + massert(st=get_mmap(f,&est)); +@@ -358,13 +360,9 @@ find_init_string(const char *s) { + + for (sym=sy1;symn.n.n_zeroes ? sym->n.n_name : st1+sym->n.n.n_offset; +- +- if (!strncmp(s,"_init_",6)) { +- if (sym->n.n.n_zeroes) +- STOP((char *)s,o=make_simple_string(s)); +- else +- o=make_simple_string(s); ++ NM(sym,st1,s,if (!strncmp(s,"_init_",6)) o=make_simple_string(s)); ++ ++ if (o!=OBJNULL) { + massert(!un_mmap(st,&est)); + massert(!fclose(f)); + return o; +--- gcl-2.6.12.orig/o/sockets.c ++++ gcl-2.6.12/o/sockets.c +@@ -33,8 +33,8 @@ Foundation, 675 Mass Ave, Cambridge, MA + # include + # include + #else +-# include + # include ++# include + #endif + + #ifdef __STDC__ +--- gcl-2.6.12.orig/o/unexnt.c ++++ gcl-2.6.12/o/unexnt.c +@@ -780,7 +780,7 @@ map_in_heap (char *filename) + } + + size = get_committed_heap_size (); +- file_base = MapViewOfFileEx (file_mapping, FILE_MAP_COPY, 0, ++ file_base = MapViewOfFileEx (file_mapping, FILE_MAP_COPY|FILE_MAP_EXECUTE, 0, + heap_index_in_executable, size, + get_heap_start ()); + if (file_base != 0) +@@ -794,7 +794,7 @@ map_in_heap (char *filename) + CloseHandle (file_mapping); + + if (VirtualAlloc (get_heap_start (), get_committed_heap_size (), +- MEM_RESERVE | MEM_COMMIT, PAGE_READWRITE) == NULL) ++ MEM_RESERVE | MEM_COMMIT, PAGE_EXECUTE_READWRITE) == NULL) + { + i = GetLastError (); + do_gcl_abort(); +@@ -1057,7 +1057,7 @@ sbrk (ptrdiff_t increment) + + /* Commit more of our heap. */ + if (VirtualAlloc (data_region_end, size, MEM_COMMIT, +- PAGE_READWRITE) == NULL) ++ PAGE_EXECUTE_READWRITE) == NULL) + return NULL; + data_region_end += size; + +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -21,6 +21,7 @@ Foundation, 675 Mass Ave, Cambridge, MA + + #include + #include ++#include + + #define IN_UNIXFSYS + #include "include.h" +@@ -72,39 +73,43 @@ coerce_to_filename1(object spec, char *p + memcpy(p,namestring->st.st_self,namestring->st.st_fillp); + p[namestring->st.st_fillp]=0; + +-#ifdef FIX_FILENAME +- FIX_FILENAME(spec,p); +-#endif +- + } + ++#ifndef __MINGW32__ ++static char GETPW_BUF[4096]; ++#endif ++ + DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { ++#ifndef __MINGW32__ + struct passwd *pwent,pw; + long r; + + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +- massert(r<=sizeof(FN1));/*FIXME maybe once at image startup*/ ++ massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ + +- massert(!getpwuid_r(uid,&pw,FN1,r,&pwent)); ++ massert(!getpwuid_r(uid,&pw,GETPW_BUF,r,&pwent)); + + RETURN1(make_simple_string(pwent->pw_name)); +- ++#else ++ RETURN1(Cnil); ++#endif + } + + DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { + ++#ifndef __MINGW32__ + struct passwd *pwent,pw; + long r; + + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); +- massert(r<=sizeof(FN1));/*FIXME maybe once at image startup*/ ++ massert(r<=sizeof(GETPW_BUF));/*FIXME maybe once at image startup*/ + + if (nm->st.st_fillp==1) + + if ((pw.pw_dir=getenv("HOME"))) + pwent=&pw; + else +- massert(!getpwuid_r(getuid(),&pw,FN1,r,&pwent) && pwent); ++ massert(!getpwuid_r(getuid(),&pw,GETPW_BUF,r,&pwent) && pwent); + + else { + +@@ -112,15 +117,19 @@ DEFUN_NEW("HOME-NAMESTRING",object,fShom + memcpy(FN2,nm->st.st_self+1,nm->st.st_fillp-1); + FN2[nm->st.st_fillp-1]=0; + +- massert(!getpwnam_r(FN2,&pw,FN1,r,&pwent) && pwent); ++ massert(!getpwnam_r(FN2,&pw,GETPW_BUF,r,&pwent) && pwent); + + } + +- massert(strlen(pwent->pw_dir)+2pw_dir,strlen(pwent->pw_dir)); +- FN3[strlen(pwent->pw_dir)]='/'; +- FN3[strlen(pwent->pw_dir)+1]=0; ++ massert((r=strlen(pwent->pw_dir))+2pw_dir,r); ++ FN3[r]='/'; ++ FN3[r+1]=0; + RETURN1(make_simple_string(FN3)); ++#else ++ massert(snprintf(FN1,sizeof(FN1)-1,"%s%s",getenv("SystemDrive"),getenv("HOMEPATH"))>=0); ++ RETURN1(make_simple_string(FN1)); ++#endif + + } + +@@ -160,28 +169,61 @@ DEF_ORDINARY("DIRECTORY",sKdirectory,KEY + DEF_ORDINARY("LINK",sKlink,KEYWORD,""); + DEF_ORDINARY("FILE",sKfile,KEYWORD,""); + ++object ++file_stream(object x) { ++ if (type_of(x)==t_stream) ++ switch(x->sm.sm_mode) { ++ case smm_input: ++ case smm_output: ++ case smm_io: ++ case smm_probe: ++ return x; ++ case smm_synonym: ++ return file_stream(x->sm.sm_object0->s.s_dbind); ++ default: ++ break; ++ } ++ return Cnil; ++} ++ ++ + DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + struct stat ss; + +- check_type_string(&x); +- coerce_to_filename(x,FN1); ++ if (type_of(x)==t_string) { ++ ++ coerce_to_filename(x,FN1); + + #ifdef __MINGW32__ +- { +- char *p=FN1+strlen(FN1)-1; +- for (;p>FN1 && *p=='/';p--) +- *p=0; +- } ++ {char *p=FN1+strlen(FN1)-1;for (;p>FN1 && *p=='/';p--) *p=0;} + #endif +- if (lstat(FN1,&ss)) ++ if (lstat(FN1,&ss)) ++ RETURN1(Cnil); ++ } else if ((x=file_stream(x))!=Cnil&&x->sm.sm_fp) { ++ if (fstat(fileno(x->sm.sm_fp),&ss)) ++ RETURN1(Cnil); ++ } else + RETURN1(Cnil); +- else +- RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : +- (S_ISLNK(ss.st_mode) ? sKlink : sKfile), +- make_fixnum(ss.st_size), +- make_fixnum(ss.st_mtime), +- make_fixnum(ss.st_uid)); ++ ++ RETURN4(S_ISDIR(ss.st_mode) ? sKdirectory : ++ (S_ISLNK(ss.st_mode) ? sKlink : sKfile), ++ make_fixnum(ss.st_size), ++ make_fixnum(ss.st_mtime), ++ make_fixnum(ss.st_uid)); ++ ++} ++ ++DEFUN_NEW("FTELL",object,fSftell,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { ++ ++ RETURN1((x=file_stream(x))!=Cnil&&x->sm.sm_fp ? (object)ftell(x->sm.sm_fp) : (object)0); ++ ++} ++ ++DEFUN_NEW("FSEEK",object,fSfseek,SI,2,2,NONE,OO,IO,OO,OO,(object x,fixnum pos),"") { ++ ++ RETURN1((x=file_stream(x))!=Cnil&&x->sm.sm_fp&&!fseek(x->sm.sm_fp,pos,SEEK_SET) ? Ct : Cnil); ++ + } + + #include +@@ -198,7 +240,11 @@ DEFUN_NEW("READLINKAT",object,fSreadlink + massert(z1st.st_self,z1); + FN1[z1]=0; ++#ifndef __MINGW32__ + massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && ld_type ++#else ++#define get_d_type(e,s) \ ++ ({struct stat ss;\ ++ massert(snprintf(FN1,sizeof(FN1),"%-*.*s%s",s->st.st_fillp,s->st.st_fillp,s->st.st_self,e->d_name)>=0);\ ++ lstat(FN1,&ss);S_ISDIR(ss.st_mode) ? DT_DIR : DT_REG;}) ++#endif + + if (!x) RETURN1(Cnil); + + tl=telldir((DIR *)x); + +-#ifndef HAVE_D_TYPE +- y=DT_UNKNOWN; +-#endif +- for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); ++ for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && y!=(d_type=get_d_type(e,s));); + if (!e) RETURN1(Cnil); + + if (s==Cnil) +@@ -290,9 +354,7 @@ DEFUN_NEW("READDIR",object,fSreaddir,SI, + } + } + +-#ifdef HAVE_D_TYPE +- if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type)); +-#endif ++ if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(d_type)); + + RETURN1(z); + +--- gcl-2.6.12.orig/o/unixsys.c ++++ gcl-2.6.12/o/unixsys.c +@@ -24,10 +24,14 @@ Foundation, 675 Mass Ave, Cambridge, MA + #include + #include + #include ++#ifndef __MINGW32__ + #include ++#endif + + #include "include.h" + ++#ifndef __MINGW32__ ++ + int + vsystem(const char *command) { + +@@ -43,12 +47,13 @@ vsystem(const char *command) { + + else { + +- z=alloca(n); +- memcpy(z,command,n); ++ massert(ns.s_dbind=Cnil; +- +- if (stat(s,&ss)) +- return; +- +- massert(f=fopen(s,"r")); +- massert(fscanf(f,"%s",b)==1); +- massert(fscanf(f,"%s",b)==1); +- massert(!fclose(f)); +- +- if (strncmp("wineserver",b,9)) +- return; +- +- massert(o=sSAsystem_directoryA->s.s_dbind); +- massert(o!=Cnil); +- mpid=getpid(); +- +- massert(snprintf(b,sizeof(b),"%-.*smsys /tmp/ out%0d tmp%0d log%0d", +- o->st.st_fillp,o->st.st_self,mpid,mpid,mpid)>0); +- massert(!psystem(b)); +- +- sSAwine_detectedA->s.s_dbind=Ct; +- +- massert(!atexit(close_msys)); +- +-} +-#endif +- + int + msystem(const char *s) { + +- int r; +- +-#ifdef _WIN32 +- +- if (sSAwine_detectedA->s.s_dbind==Ct) { +- +- char b[4096],b1[4096],c; +- FILE *fp; +- +- massert(snprintf(b,sizeof(b),"/tmp/out%0d",mpid)>0); +- massert(snprintf(b1,sizeof(b1),"%s1",b)>0); +- +- massert(fp=fopen(b1,"w")); +- massert(fprintf(fp,"%s",s)>=0); +- massert(!fclose(fp)); +- +- massert(MoveFileEx(b1,b,MOVEFILE_REPLACE_EXISTING)); +- +- if (!*s) +- return 0; +- +- for (;;Sleep(100)) { +- +- massert(fp=fopen(b,"r")); +- massert((c=fgetc(fp))!=EOF); +- if (c!=s[0]) { +- massert(ungetc(c,fp)!=EOF); +- break; +- } +- massert(!fclose(fp)); +- +- } +- +- massert(fscanf(fp,"%d",&r)==1); +- massert(!fclose(fp)); +- +- } else +- +-#endif +- +- r=psystem(s); +- +- return r; ++ return psystem(s); + + } + +--- gcl-2.6.12.orig/unixport/makefile ++++ gcl-2.6.12/unixport/makefile +@@ -77,8 +77,8 @@ sys_init.lsp: sys_init.lsp.in + -e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \ + -e "s#@LI-MAJVERS@#`cat ../majvers`#1" \ + -e "s#@LI-RELEASE@#`cat ../release`#1" \ +- -e "s#@LI-CC@#\"$(CC) -c $(FINAL_CFLAGS)\"#1" \ +- -e "s#@LI-LD@#\"$(CC) $(LD_FLAGS) -o \"#1" \ ++ -e "s#@LI-CC@#\"$(GCL_CC) -c $(FINAL_CFLAGS)\"#1" \ ++ -e "s#@LI-LD@#\"$(GCL_CC) $(LD_FLAGS) -o \"#1" \ + -e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \ + -e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \ + -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \ +@@ -92,7 +92,7 @@ saved_%:raw_% $(RSYM) sys_init.lsp raw_% + + cp sys_init.lsp foo + echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo +- ar x lib$*.a $$(ar t lib$*.a |grep ^gcl_) ++ j=$$(ar t lib$*.a |grep ^gcl_);[ "$$j" = "" ] || ar x lib$*.a $$j #accelerator + $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo + # check that saved image can be prelinked + [ "$(PRELINK_CHECK)" = "" ] || \ +--- gcl-2.6.12.orig/unixport/sys.c ++++ gcl-2.6.12/unixport/sys.c +@@ -15,16 +15,6 @@ ar_init_fn(void (fn)(void),const char *s + if (stat(s,&ss)) { + assert(snprintf(b,sizeof(b),"ar x %-.*slib%sgcl.a %s",sysd->st.st_fillp,sysd->st.st_self,FLAVOR,s)>0); + assert(!msystem(b)); +-#ifdef _WIN32 +- if (sSAwine_detectedA->s.s_dbind!=Cnil) { +- char *n; +- unsigned l; +- l=strlen(s)+6; +- n=alloca(l); +- snprintf(n,l,"/tmp/%s",s); +- s=(void *)n; +- } +-#endif + } + gcl_init_or_load1(fn,s); + assert(!unlink(s)); diff --git a/patches/pathnames1.6 b/patches/pathnames1.6 new file mode 100644 index 00000000..a5aab6c5 --- /dev/null +++ b/patches/pathnames1.6 @@ -0,0 +1,42 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-42) unstable; urgency=medium + . + * pathnames1.6 + * Bug fix: "FTBFS with bindnow and PIE enabled", thanks to Balint Reczey + (Closes: #837481). + * Bug fix: "FTBFS with compilers that default to -fPIE (patch + attached)", thanks to Adam Conrad (Closes: #822820). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/822820 +Bug-Debian: https://bugs.debian.org/837481 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-26 + +--- gcl-2.6.12.orig/o/makefile ++++ gcl-2.6.12/o/makefile +@@ -34,7 +34,7 @@ boot.o: boot.c $(DECL) boot.h + $(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) + + prelink.o: prelink.c $(DECL) +- $(CC) -fPIE -c $(filter-out -pg,$(CFLAGS)) $(DEFS) $*.c $(AUX_INFO) ++ $(CC) -c $(filter-out -pg,$(CFLAGS)) -fPIE $(DEFS) $*.c $(AUX_INFO) + + %.o: %.c $(DECL) + $(CC) -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) diff --git a/patches/pathnames1.7 b/patches/pathnames1.7 new file mode 100644 index 00000000..64d424ab --- /dev/null +++ b/patches/pathnames1.7 @@ -0,0 +1,601 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-42) unstable; urgency=medium + . + * pathnames1.6 + * Bug fix: "FTBFS with bindnow and PIE enabled", thanks to Balint Reczey + (Closes: #837481). + * Bug fix: "FTBFS with compilers that default to -fPIE (patch + attached)", thanks to Adam Conrad (Closes: #822820). +Author: Camm Maguire +Bug-Debian: https://bugs.debian.org/822820 +Bug-Debian: https://bugs.debian.org/837481 + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-27 + +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -3853,9 +3853,8 @@ if echo $GCL_CC |grep gcc |grep -q win; + fi + + +-add_arg_to_tcflags() { ++add_arg_to_cflags() { + +- local i=1 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLAG $1" >&5 + $as_echo_n "checking for CFLAG $1... " >&6; } + CFLAGS_ORI=$CFLAGS +@@ -3877,8 +3876,8 @@ main () + } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- TCFLAGS="$TCFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +-$as_echo "yes" >&6; };i=0 ++ CFLAGS="$CFLAGS_ORI $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; };return 0 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +@@ -3888,27 +3887,26 @@ rm -f core *.core core.conftest.* gmon.o + fi + + CFLAGS=$CFLAGS_ORI +- return $i ++ return 1 + + } + +-assert_arg_to_tcflags() { +- if ! add_arg_to_tcflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to CFLAGS" >&5 ++assert_arg_to_cflags() { ++ if ! add_arg_to_cflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to CFLAGS" >&5 + $as_echo "cannot add $1 to CFLAGS" >&6; }; exit 1 ; fi + return 0 + } + +-add_args_to_tcflags() { ++add_args_to_cflags() { + + while test "$#" -ge 1 ; do +- add_arg_to_tcflags $1 ++ add_arg_to_cflags $1 + shift + done + } + +-add_arg_to_tldflags() { ++add_arg_to_ldflags() { + +- local i=1 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LDFLAG $1" >&5 + $as_echo_n "checking for LDFLAG $1... " >&6; } + LDFLAGS_ORI=$LDFLAGS +@@ -3929,8 +3927,8 @@ main () + } + _ACEOF + if ac_fn_c_try_run "$LINENO"; then : +- TLDFLAGS="$TLDFLAGS $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +-$as_echo "yes" >&6; };i=0 ++ LDFLAGS="$LDFLAGS_ORI $1";{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 ++$as_echo "yes" >&6; };return 0 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 + $as_echo "no" >&6; } +@@ -3940,20 +3938,20 @@ rm -f core *.core core.conftest.* gmon.o + fi + + LDFLAGS=$LDFLAGS_ORI +- return $i ++ return 1 + + } + +-assert_arg_to_tldflags() { +- if ! add_arg_to_tldflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to LDFLAGS" >&5 ++assert_arg_to_ldflags() { ++ if ! add_arg_to_ldflags $1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: cannot add $1 to LDFLAGS" >&5 + $as_echo "cannot add $1 to LDFLAGS" >&6; }; exit 1 ; fi + return 0 + } + +-add_args_to_tldflags() { ++add_args_to_ldflags() { + + while test "$#" -ge 1 ; do +- add_arg_to_tldflags $1 ++ add_arg_to_ldflags $1 + shift + done + } +@@ -3975,16 +3973,14 @@ $as_echo "removing $1 from LDFLAGS" >&6; + + } + +-TCFLAGS="" +-add_args_to_tcflags -fsigned-char -pipe \ ++add_args_to_cflags -fsigned-char -pipe \ + -fno-builtin-malloc -fno-builtin-free \ + -fno-PIE -fno-pie -fno-PIC -fno-pic \ + -Wall \ + -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ + -Wno-unused-but-set-variable -Wno-misleading-indentation + +-TLDFLAGS="" +-add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 + $as_echo_n "checking for clang... " >&6; } +@@ -4032,29 +4028,29 @@ fi + + case $use in + *mingw*) +- assert_arg_to_tcflags -fno-zero-initialized-in-bss +- assert_arg_to_tcflags -mms-bitfields;; ++ assert_arg_to_cflags -fno-zero-initialized-in-bss ++ assert_arg_to_cflags -mms-bitfields;; + *gnuwin*) +- assert_arg_to_tcflags -fno-zero-initialized-in-bss +- assert_arg_to_tcflags -mms-bitfields +- assert_arg_to_tldflags -Wl,--stack,8000000;; ++ assert_arg_to_cflags -fno-zero-initialized-in-bss ++ assert_arg_to_cflags -mms-bitfields ++ assert_arg_to_ldflags -Wl,--stack,8000000;; + 386-macosx) +- assert_arg_to_tldflags -Wl,-no_pie ++ assert_arg_to_ldflags -Wl,-no_pie + if test "$build_cpu" = "x86_64" ; then +- assert_arg_to_tcflags -m64 +- assert_arg_to_tldflags -m64 +- assert_arg_to_tldflags -Wl,-headerpad,72 ++ assert_arg_to_cflags -m64 ++ assert_arg_to_ldflags -m64 ++ assert_arg_to_ldflags -Wl,-headerpad,72 + else +- assert_arg_to_tcflags -m32 +- assert_arg_to_tldflags -m32 +- assert_arg_to_tldflags -Wl,-headerpad,56 ++ assert_arg_to_cflags -m32 ++ assert_arg_to_ldflags -m32 ++ assert_arg_to_ldflags -Wl,-headerpad,56 + fi;; +- FreeBSD) assert_arg_to_tldflags -Z;; ++ FreeBSD) assert_arg_to_ldflags -Z;; + esac + + if test "$enable_static" = "yes" ; then +- assert_arg_to_tldflags -static +- assert_arg_to_tldflags -Wl,-zmuldefs ++ assert_arg_to_ldflags -static ++ assert_arg_to_ldflags -Wl,-zmuldefs + + $as_echo "#define STATIC_LINKING 1" >>confdefs.h + +@@ -4148,7 +4144,7 @@ cat >>confdefs.h <<_ACEOF + #define GCL_GPROF_START $GCL_GPROF_START + _ACEOF + +- assert_arg_to_tcflags -pg ++ assert_arg_to_cflags -pg + case $use in + s390*) ;; # relocation truncation bug in gcc + *) TLIBS="$TLIBS -pg";; +@@ -4164,7 +4160,7 @@ fi + + + if test "$enable_debug" = "yes" ; then +- assert_arg_to_tcflags -g ++ assert_arg_to_cflags -g + # for subconfigurations + CFLAGS="$CFLAGS -g" + else +@@ -4175,41 +4171,41 @@ fi + # gcc on ppc cannot compile our new_init.c with full opts --CM + TONIFLAGS="" + case $use in +- powerpc*macosx) assert_arg_to_tcflags -mlongcall;; ++ powerpc*macosx) assert_arg_to_cflags -mlongcall;; + *linux) + case $use in + alpha*) +- assert_arg_to_tcflags -mieee ++ assert_arg_to_cflags -mieee + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 + ;; + aarch64*) + TLIBS="$TLIBS -lgcc_s";; + hppa*) +- assert_arg_to_tcflags -mlong-calls ++ assert_arg_to_cflags -mlong-calls + TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 + ;; + mips*) + case $canonical in + mips64*linux*) +- assert_arg_to_tldflags -Wl,-z,now;; ++ assert_arg_to_ldflags -Wl,-z,now;; + esac + ;; + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; + arm*) +- assert_arg_to_tcflags -mlong-calls +- assert_arg_to_tcflags -fdollars-in-identifiers +- assert_arg_to_tcflags -g #? ++ assert_arg_to_cflags -mlong-calls ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? + ;; + powerpc*) +- assert_arg_to_tcflags -mlongcall ++ assert_arg_to_cflags -mlongcall + ;; + esac;; + esac + if test "$enable_pic" = "yes" ; then +- assert_arg_to_tcflags -fPIC ++ assert_arg_to_cflags -fPIC + fi + + +@@ -5385,7 +5381,7 @@ fi + + + TLIBS="$TLIBS -ldl -rdynamic" +- assert_arg_to_tcflags -fPIC ++ assert_arg_to_cflags -fPIC + + $as_echo "#define USE_DLOPEN 1" >>confdefs.h + +@@ -5869,7 +5865,7 @@ $as_echo "#define HAVE_XDR 1" >>confdefs + + if test "$XDR_LIB" != " "; then + TLIBS="$TLIBS -l$XDR_LIB" +- add_arg_to_tcflags -I/usr/include/$XDR_LIB ++ add_arg_to_cflags -I/usr/include/$XDR_LIB + fi + fi + fi +@@ -6935,7 +6931,7 @@ if test "$use" != "386-gnu" ; then #hurd + $as_echo_n "checking finding default linker script... " >&6; } + touch unixport/gcl.script + echo "int main() {return 0;}" >foo.c +- $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ ++ $CC $LDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ + $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script + rm -rf foo.c foo + +@@ -6956,7 +6952,7 @@ $as_echo "$as_me: trying to adjust text + cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[0-9]*","0x" j,$0);} {print}' j=$j >gcl.script + # diff -u gcl.script.def gcl.script + echo "int main() {return 0;}" >foo.c +- if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++ if ( $CC $LDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then + if test $n -lt $min ; then min=$n; fi; + if test $n -gt $max; then max=$n; fi; + elif test $max -gt 0 ; then +@@ -7020,7 +7016,7 @@ $as_echo_n "checking our linker script.. + { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 + $as_echo "done" >&6; } + rm -f gcl.script.def +- LDFLAGS="$LDFLAGS -Wl,-T gcl.script " ++ assert_arg_to_ldflags -Wl,-T,gcl.script + cp gcl.script unixport + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none found or not needed" >&5 +@@ -9065,16 +9061,16 @@ fi + + + +-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" ++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" + + LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + +-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" ++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" + + # Work around bug with gcc on ppc -- CM +-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" ++NIFLAGS="$CFLAGS $CPPFLAGS $TONIFLAGS -I\$(GCLDIR)/o" + +-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" ++CFLAGS="$CFLAGS $CPPFLAGS $TO3FLAGS -I\$(GCLDIR)/o" + + O3FLAGS=$TO3FLAGS + +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -185,60 +185,58 @@ if echo $GCL_CC |grep gcc |grep -q win; + fi + AC_SUBST(GCL_CC) + +-add_arg_to_tcflags() { ++add_arg_to_cflags() { + +- local i=1 + AC_MSG_CHECKING([for CFLAG $1]) + CFLAGS_ORI=$CFLAGS + CFLAGS="$CFLAGS -Werror $1 `echo $1|sed 's,-Wno-,-W,1'`" + AC_RUN_IFELSE( + [AC_LANG_PROGRAM([[]],[[]])], +- [TCFLAGS="$TCFLAGS $1";AC_MSG_RESULT([yes]);i=0], ++ [CFLAGS="$CFLAGS_ORI $1";AC_MSG_RESULT([yes]);return 0], + [AC_MSG_RESULT([no])], + [AC_MSG_RESULT([no])]) + CFLAGS=$CFLAGS_ORI +- return $i ++ return 1 + + } + +-assert_arg_to_tcflags() { +- if ! add_arg_to_tcflags $1 ; then AC_MSG_RESULT([cannot add $1 to CFLAGS]); exit 1 ; fi ++assert_arg_to_cflags() { ++ if ! add_arg_to_cflags $1 ; then AC_MSG_RESULT([cannot add $1 to CFLAGS]); exit 1 ; fi + return 0 + } + +-add_args_to_tcflags() { ++add_args_to_cflags() { + + while test "$#" -ge 1 ; do +- add_arg_to_tcflags $1 ++ add_arg_to_cflags $1 + shift + done + } + +-add_arg_to_tldflags() { ++add_arg_to_ldflags() { + +- local i=1 + AC_MSG_CHECKING([for LDFLAG $1]) + LDFLAGS_ORI=$LDFLAGS + LDFLAGS="$LDFLAGS -Werror $1" + AC_RUN_IFELSE( + [AC_LANG_PROGRAM([[]],[[]])], +- [TLDFLAGS="$TLDFLAGS $1";AC_MSG_RESULT([yes]);i=0], ++ [LDFLAGS="$LDFLAGS_ORI $1";AC_MSG_RESULT([yes]);return 0], + [AC_MSG_RESULT([no])], + [AC_MSG_RESULT([no])]) + LDFLAGS=$LDFLAGS_ORI +- return $i ++ return 1 + + } + +-assert_arg_to_tldflags() { +- if ! add_arg_to_tldflags $1 ; then AC_MSG_RESULT([cannot add $1 to LDFLAGS]); exit 1 ; fi ++assert_arg_to_ldflags() { ++ if ! add_arg_to_ldflags $1 ; then AC_MSG_RESULT([cannot add $1 to LDFLAGS]); exit 1 ; fi + return 0 + } + +-add_args_to_tldflags() { ++add_args_to_ldflags() { + + while test "$#" -ge 1 ; do +- add_arg_to_tldflags $1 ++ add_arg_to_ldflags $1 + shift + done + } +@@ -259,16 +257,14 @@ remove_arg_from_ldflags() { + + } + +-TCFLAGS="" +-add_args_to_tcflags -fsigned-char -pipe \ ++add_args_to_cflags -fsigned-char -pipe \ + -fno-builtin-malloc -fno-builtin-free \ + -fno-PIE -fno-pie -fno-PIC -fno-pic \ + -Wall \ + -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ + -Wno-unused-but-set-variable -Wno-misleading-indentation + +-TLDFLAGS="" +-add_args_to_tldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy + + AC_MSG_CHECKING([for clang]) + AC_RUN_IFELSE( +@@ -290,29 +286,29 @@ AC_RUN_IFELSE( + + case $use in + *mingw*) +- assert_arg_to_tcflags -fno-zero-initialized-in-bss +- assert_arg_to_tcflags -mms-bitfields;; ++ assert_arg_to_cflags -fno-zero-initialized-in-bss ++ assert_arg_to_cflags -mms-bitfields;; + *gnuwin*) +- assert_arg_to_tcflags -fno-zero-initialized-in-bss +- assert_arg_to_tcflags -mms-bitfields +- assert_arg_to_tldflags -Wl,--stack,8000000;; ++ assert_arg_to_cflags -fno-zero-initialized-in-bss ++ assert_arg_to_cflags -mms-bitfields ++ assert_arg_to_ldflags -Wl,--stack,8000000;; + 386-macosx) +- assert_arg_to_tldflags -Wl,-no_pie ++ assert_arg_to_ldflags -Wl,-no_pie + if test "$build_cpu" = "x86_64" ; then +- assert_arg_to_tcflags -m64 +- assert_arg_to_tldflags -m64 +- assert_arg_to_tldflags -Wl,-headerpad,72 ++ assert_arg_to_cflags -m64 ++ assert_arg_to_ldflags -m64 ++ assert_arg_to_ldflags -Wl,-headerpad,72 + else +- assert_arg_to_tcflags -m32 +- assert_arg_to_tldflags -m32 +- assert_arg_to_tldflags -Wl,-headerpad,56 ++ assert_arg_to_cflags -m32 ++ assert_arg_to_ldflags -m32 ++ assert_arg_to_ldflags -Wl,-headerpad,56 + fi;; +- FreeBSD) assert_arg_to_tldflags -Z;; ++ FreeBSD) assert_arg_to_ldflags -Z;; + esac + + if test "$enable_static" = "yes" ; then +- assert_arg_to_tldflags -static +- assert_arg_to_tldflags -Wl,-zmuldefs ++ assert_arg_to_ldflags -static ++ assert_arg_to_ldflags -Wl,-zmuldefs + AC_DEFINE(STATIC_LINKING,1,[staticly linked images]) + fi + +@@ -353,7 +349,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + if test "$GCL_GPROF_START" != "" ; then + AC_MSG_RESULT($GCL_GPROF_START) + AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof]) +- assert_arg_to_tcflags -pg ++ assert_arg_to_cflags -pg + case $use in + s390*) ;; # relocation truncation bug in gcc + *) TLIBS="$TLIBS -pg";; +@@ -365,7 +361,7 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof + fi]) + + if test "$enable_debug" = "yes" ; then +- assert_arg_to_tcflags -g ++ assert_arg_to_cflags -g + # for subconfigurations + CFLAGS="$CFLAGS -g" + else +@@ -376,41 +372,41 @@ fi + # gcc on ppc cannot compile our new_init.c with full opts --CM + TONIFLAGS="" + case $use in +- powerpc*macosx) assert_arg_to_tcflags -mlongcall;; ++ powerpc*macosx) assert_arg_to_cflags -mlongcall;; + *linux) + case $use in + alpha*) +- assert_arg_to_tcflags -mieee ++ assert_arg_to_cflags -mieee + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.8.1 + ;; + aarch64*) + TLIBS="$TLIBS -lgcc_s";; + hppa*) +- assert_arg_to_tcflags -mlong-calls ++ assert_arg_to_cflags -mlong-calls + TLIBS="$TLIBS -lgcc_s" # workaround hppa __moddi3 local func symbols with default linker flags + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O2" ; TFPFLAG=""; fi #FIXME needed asof gcc 4.8.1 + ;; + mips*) + case $canonical in + mips64*linux*) +- assert_arg_to_tldflags -Wl,-z,now;; ++ assert_arg_to_ldflags -Wl,-z,now;; + esac + ;; + ia64*) + if test "$enable_debug" != "yes" ; then TO3FLAGS="-O" ; fi #FIXME needed asof gcc 4.8.1 + ;; + arm*) +- assert_arg_to_tcflags -mlong-calls +- assert_arg_to_tcflags -fdollars-in-identifiers +- assert_arg_to_tcflags -g #? ++ assert_arg_to_cflags -mlong-calls ++ assert_arg_to_cflags -fdollars-in-identifiers ++ assert_arg_to_cflags -g #? + ;; + powerpc*) +- assert_arg_to_tcflags -mlongcall ++ assert_arg_to_cflags -mlongcall + ;; + esac;; + esac + if test "$enable_pic" = "yes" ; then +- assert_arg_to_tcflags -fPIC ++ assert_arg_to_cflags -fPIC + fi + + +@@ -715,7 +711,7 @@ if test "$enable_dlopen" = "yes" ; then + AC_CHECK_LIB([dl],[dlopen],,AC_MSG_ERROR([Cannot find dlopen])) + + TLIBS="$TLIBS -ldl -rdynamic" +- assert_arg_to_tcflags -fPIC ++ assert_arg_to_cflags -fPIC + AC_DEFINE(USE_DLOPEN,1,[link compiled objects via libdl]) + + fi +@@ -834,7 +830,7 @@ if test "$enable_xdr" != "no" ; then + AC_DEFINE(HAVE_XDR,1,[have xdr extensions]) + if test "$XDR_LIB" != " "; then + TLIBS="$TLIBS -l$XDR_LIB" +- add_arg_to_tcflags -I/usr/include/$XDR_LIB ++ add_arg_to_cflags -I/usr/include/$XDR_LIB + fi + fi + fi +@@ -1345,7 +1341,7 @@ if test "$use" != "386-gnu" ; then #hurd + AC_MSG_CHECKING([finding default linker script]) + touch unixport/gcl.script + echo "int main() {return 0;}" >foo.c +- $CC $TLDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ ++ $CC $LDFLAGS -Wl,--verbose foo.c -o foo 2>&1 | \ + $AWK '/\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=\=/ {i=1-i;next} {if (i) print}' >gcl.script + rm -rf foo.c foo + +@@ -1364,7 +1360,7 @@ if test "$use" != "386-gnu" ; then #hurd + cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[[0-9]]*","0x" j,$0);} {print}' j=$j >gcl.script + # diff -u gcl.script.def gcl.script + echo "int main() {return 0;}" >foo.c +- if ( $CC $TLDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then ++ if ( $CC $LDFLAGS -Wl,-T gcl.script foo.c -o foo && ./foo ) >/dev/null 2>&1 ; then + if test $n -lt $min ; then min=$n; fi; + if test $n -gt $max; then max=$n; fi; + elif test $max -gt 0 ; then +@@ -1409,7 +1405,7 @@ if test "$use" != "386-gnu" ; then #hurd + cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[[0-9]]*","0x" j,$0);} {print}' j=$j >gcl.script + AC_MSG_RESULT([done]) + rm -f gcl.script.def +- LDFLAGS="$LDFLAGS -Wl,-T gcl.script " ++ assert_arg_to_ldflags -Wl,-T,gcl.script + cp gcl.script unixport + else + AC_MSG_RESULT([none found or not needed]) +@@ -2116,16 +2112,16 @@ AC_CHECK_HEADERS(alloca.h) + AC_FUNC_ALLOCA + + +-LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'` $TLDFLAGS" ++LDFLAGS="`echo $LDFLAGS | sed 's,gcl.script,../unixport/gcl.script,g'`" + AC_SUBST(LDFLAGS) + LIBS="$X_PRE_LIBS $X_LIBS $X_EXTRA_LIBS $LIBS $TLIBS" + AC_SUBST(LIBS) +-FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS $TCFLAGS" ++FINAL_CFLAGS="$CFLAGS $CPPFLAGS $X_CFLAGS" + AC_SUBST(FINAL_CFLAGS) + # Work around bug with gcc on ppc -- CM +-NIFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TONIFLAGS -I\$(GCLDIR)/o" ++NIFLAGS="$CFLAGS $CPPFLAGS $TONIFLAGS -I\$(GCLDIR)/o" + AC_SUBST(NIFLAGS) +-CFLAGS="$CFLAGS $CPPFLAGS $TCFLAGS $TO3FLAGS -I\$(GCLDIR)/o" ++CFLAGS="$CFLAGS $CPPFLAGS $TO3FLAGS -I\$(GCLDIR)/o" + AC_SUBST(CFLAGS) + O3FLAGS=$TO3FLAGS + AC_SUBST(O3FLAGS) diff --git a/patches/pathnames1.9 b/patches/pathnames1.9 new file mode 100644 index 00000000..71ee3bd1 --- /dev/null +++ b/patches/pathnames1.9 @@ -0,0 +1,5609 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-43) unstable; urgency=medium + . + * pathnames1.7 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2016-10-28 + +--- gcl-2.6.12.orig/ansi-tests/ansi-aux.lsp ++++ gcl-2.6.12/ansi-tests/ansi-aux.lsp +@@ -1635,3 +1635,6 @@ the condition to go uncaught if it canno + + (defmacro expand-in-current-env (macro-form &environment env) + (macroexpand macro-form env)) ++ ++(defun typep* (element type) ++ (not (not (typep element type)))) +--- gcl-2.6.12.orig/clcs/sys-proclaim.lisp ++++ gcl-2.6.12/clcs/sys-proclaim.lisp +@@ -2,30 +2,14 @@ + (COMMON-LISP::IN-PACKAGE "CONDITIONS") + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- CONDITIONS::IS-WARNING CONDITIONS::DEFAULT-REPORT +- CONDITIONS::IS-CONDITION CONDITIONS::CONDITIONP)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| +- CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))|)) ++ COMMON-LISP::MAKE-CONDITION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -36,11 +20,27 @@ + CONDITIONS::|(PCL::FAST-METHOD MAKE-LOAD-FORM (CONDITION))|)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ CONDITIONS::IS-CONDITION CONDITIONS::DEFAULT-REPORT ++ CONDITIONS::IS-WARNING CONDITIONS::CONDITIONP)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::*) +- COMMON-LISP::MAKE-CONDITION)) +\ No newline at end of file ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))| ++ CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))|)) +\ No newline at end of file +--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp ++++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp +@@ -430,7 +430,7 @@ Cannot compile ~a.~%" + (si::copy-stream st *standard-output*)) + (with-open-file (st hn) + (si::copy-stream st *standard-output*)) +- (when (eql (aref *objdump* 0) #\/);program found at startup in path ++ (when *objdump* + (safe-system (si::string-concatenate *objdump* (namestring on)))) + (mdelete-file cn) + (mdelete-file dn) +--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp ++++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp +@@ -43,7 +43,6 @@ + (DEFSYSFUN 'RASSOC "Lrassoc" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'PPRINT "Lpprint" '(T *) 'T NIL NIL) + (DEFSYSFUN 'NSUBST-IF-NOT "Lnsubst_if_not" '(T T T *) 'T NIL NIL) +-(DEFSYSFUN 'FILE-POSITION "Lfile_position" '(T *) 'T NIL NIL) + (DEFSYSFUN 'STRING< "Lstring_l" '(T T *) 'T NIL NIL) + (DEFSYSFUN 'REVERSE "Lreverse" '(T) 'T NIL NIL) + (DEFSYSFUN 'STREAMP "Lstreamp" '(T) 'T NIL T) +@@ -67,7 +66,6 @@ + (DEFSYSFUN 'CONS "Lcons" '(T T) 'T NIL NIL) + (DEFSYSFUN 'LIST "Llist" '(*) 'T NIL NIL) + (DEFSYSFUN 'USE-PACKAGE "Luse_package" '(T *) 'T NIL NIL) +-(DEFSYSFUN 'FILE-LENGTH "Lfile_length" '(T) 'T NIL NIL) + (DEFSYSFUN 'MAKE-SYMBOL "Lmake_symbol" '(T) 'T NIL NIL) + (DEFSYSFUN 'STRING-RIGHT-TRIM "Lstring_right_trim" '(T T) 'STRING NIL + NIL) +--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp ++++ gcl-2.6.12/cmpnew/sys-proclaim.lisp +@@ -2,376 +2,394 @@ + (COMMON-LISP::IN-PACKAGE "COMPILER") + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::STRING COMMON-LISP::*) +- COMMON-LISP::T) +- COMPILER::TS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1VALUES +- COMPILER::C1RPLACA COMPILER::FUN-P +- COMPILER::FUNCTION-ARG-TYPES COMPILER::C1STRUCTURE-REF +- COMPILER::GET-RETURN-TYPE COMPILER::WT-FUNCALL-C +- COMPILER::MACRO-DEF-P COMPILER::T1DEFUN COMPILER::C1ASSOC +- COMPILER::SET-UP-VAR-CVS COMPILER::C2FUNCTION +- COMPILER::C1DM-BAD-KEY COMPILER::ADD-OBJECT +- COMPILER::WT-SWITCH-CASE COMPILER::VARARG-P +- COMPILER::C1TAGBODY COMPILER::C2GET COMPILER::VAR-REF +- COMPILER::SCH-LOCAL-FUN COMPILER::ADD-SYMBOL +- COMPILER::TAG-UNWIND-EXIT COMPILER::C1MULTIPLE-VALUE-SETQ +- COMPILER::C1PRINC COMPILER::WT-VAR-DECL COMPILER::C1QUOTE +- COMPILER::C2RPLACD COMPILER::CHECK-VREF +- COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1MAPLIST +- COMPILER::ADD-REG1 COMPILER::C1OR COMPILER::WT-SYMBOL-FUNCTION +- COMPILER::TAG-P COMPILER::SAFE-SYSTEM COMPILER::C1ECASE +- COMPILER::LTVP COMPILER::GET-INCLUDED COMPILER::INFO-P +- COMPILER::FUN-INFO COMPILER::C1LOAD-TIME-VALUE +- COMPILER::GET-LOCAL-ARG-TYPES COMPILER::BLK-P +- COMPILER::BLK-EXIT COMPILER::C2VAR-KIND COMPILER::C2LOCATION +- COMPILER::WT1 COMPILER::WT-CCB-VS +- COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::BLK-REF-CCB +- COMPILER::UNDEFINED-VARIABLE COMPILER::C1MULTIPLE-VALUE-CALL +- COMPILER::VAR-LOC COMPILER::C1SETQ COMPILER::C1NTH-CONDITION +- COMPILER::C2RPLACA COMPILER::FUN-REF COMPILER::C2VAR +- COMPILER::WT-CAR COMPILER::WT-LIST COMPILER::WRITE-BLOCK-OPEN +- COMPILER::INFO-VOLATILE COMPILER::GET-LOCAL-RETURN-TYPE +- COMPILER::AET-C-TYPE COMPILER::PUSH-ARGS COMPILER::TAG-REF-CLB +- COMPILER::BLK-REF COMPILER::VAR-P COMPILER::C1ADD-GLOBALS +- COMPILER::T3ORDINARY COMPILER::ADD-OBJECT2 COMPILER::SET-TOP +- COMPILER::T1DEFLA COMPILER::C1FUNCTION COMPILER::T3CLINES +- COMPILER::T1DEFCFUN COMPILER::C1VREF COMPILER::C1ASH +- COMPILER::BLK-NAME COMPILER::WT-CADR COMPILER::WT-DOWN +- COMPILER::C1TERPRI COMPILER::C2GETHASH COMPILER::C2GO-CCB +- COMPILER::SAVE-FUNOB COMPILER::T2DECLARE COMPILER::FUN-REF-CCB +- COMPILER::C1MAPCAR COMPILER::T1DEFMACRO +- COMPILER::C2TAGBODY-LOCAL COMPILER::C1STACK-LET +- COMPILER::INFO-TYPE COMPILER::T1MACROLET COMPILER::C1LET* +- COMPILER::C1RPLACD COMPILER::DECLARATION-TYPE +- COMPILER::T1ORDINARY COMPILER::C2EXPR* COMPILER::C1LOCAL-FUN +- COMPILER::WT-DATA-PACKAGE-OPERATION +- COMPILER::C1BOOLE-CONDITION SYSTEM::UNDEF-COMPILER-MACRO +- COMPILER::C2TAGBODY-BODY COMPILER::C1NTHCDR COMPILER::C1VAR +- COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::C1NTHCDR-CONDITION +- COMPILER::CONSTANT-FOLD-P COMPILER::C1UNWIND-PROTECT +- COMPILER::PROCLAMATION COMPILER::C1NTH COMPILER::C1RETURN-FROM +- COMPILER::INFO-SP-CHANGE COMPILER::C1LENGTH +- COMPILER::CMP-MACRO-FUNCTION COMPILER::BLK-REF-CLB +- COMPILER::NAME-TO-SD COMPILER::CTOP-WRITE COMPILER::C1MAPCON +- COMPILER::C1FUNOB COMPILER::FIX-OPT COMPILER::C1RPLACA-NTHCDR +- COMPILER::C1FLET COMPILER::RESULT-TYPE COMPILER::C1CATCH +- COMPILER::C2DM-RESERVE-V COMPILER::VAR-NAME +- COMPILER::CMP-MACROEXPAND COMPILER::VERIFY-DATA-VECTOR +- COMPILER::T1CLINES COMPILER::C1MAPL COMPILER::T1DEFENTRY +- COMPILER::TAG-REF-CCB COMPILER::WT-VS +- COMPILER::LONG-FLOAT-LOC-P COMPILER::C1MAPCAN +- COMPILER::OBJECT-TYPE COMPILER::ADD-ADDRESS +- COMPILER::RESET-INFO-TYPE COMPILER::C1BOOLE3 COMPILER::C1MEMQ +- COMPILER::C1DEFINE-STRUCTURE COMPILER::TYPE-FILTER +- COMPILER::UNWIND-NO-EXIT COMPILER::C1FMLA-CONSTANT +- COMPILER::C2DM-RESERVE-VL COMPILER::C1FSET COMPILER::LTVP-EVAL +- COMPILER::C1GO COMPILER::WT-VV COMPILER::INFO-CHANGED-ARRAY +- COMPILER::C1FUNCALL COMPILER::C2TAGBODY-CCB +- COMPILER::TAG-LABEL COMPILER::VAR-KIND COMPILER::WT-VS* +- COMPILER::VAR-TYPE COMPILER::C2GO-LOCAL COMPILER::REGISTER +- COMPILER::T1PROGN COMPILER::C1BLOCK COMPILER::TAG-SWITCH +- COMPILER::VAR-REP-LOC COMPILER::C2BIND +- COMPILER::SET-PUSH-CATCH-FRAME COMPILER::COPY-INFO +- COMPILER::C1LIST-NTH COMPILER::CONS-TO-LISTA +- COMPILER::FUN-LEVEL COMPILER::C1DOWNWARD-FUNCTION +- COMPILER::THE-PARAMETER COMPILER::C2VALUES COMPILER::C1LABELS +- COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::MDELETE-FILE +- COMPILER::WT-FUNCTION-LINK COMPILER::SAVE-AVMA +- COMPILER::VOLATILE COMPILER::ADD-CONSTANT COMPILER::C1APPLY +- COMPILER::C1GETHASH COMPILER::FUN-NAME COMPILER::DEFAULT-INIT +- COMPILER::CLINK COMPILER::WT-CDR COMPILER::PARSE-CVSPECS +- COMPILER::REP-TYPE COMPILER::C2GO-CLB +- COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::PUSH-DATA-INCF +- COMPILER::SCH-GLOBAL COMPILER::C1STRUCTURE-SET +- COMPILER::TAG-NAME COMPILER::INFO-REFERRED-ARRAY +- COMPILER::C1EXPR COMPILER::C1GET COMPILER::BLK-VAR +- COMPILER::TAG-REF COMPILER::C1MAPC COMPILER::SET-RETURN +- COMPILER::SHORT-FLOAT-LOC-P COMPILER::C1DECLARE +- COMPILER::WT-DATA1 COMPILER::FLAGS-POS +- COMPILER::BLK-VALUE-TO-GO COMPILER::NAME-SD1 +- COMPILER::C2DOWNWARD-FUNCTION COMPILER::C1SHARP-COMMA +- COMPILER::INLINE-POSSIBLE COMPILER::WT-H1 +- COMPILER::FIXNUM-LOC-P COMPILER::C1LET COMPILER::C1IF +- COMPILER::C1THE COMPILER::FUNCTION-RETURN-TYPE +- COMPILER::GET-ARG-TYPES COMPILER::INLINE-TYPE +- COMPILER::FUN-CFUN COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P +- COMPILER::CHECK-DOWNWARD COMPILER::C1PSETQ +- COMPILER::INLINE-BOOLE3-STRING COMPILER::C1THROW +- COMPILER::FSET-FN-NAME COMPILER::T1DEFINE-STRUCTURE +- COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C1PROGN +- COMPILER::C2FUNCALL-AUX COMPILER::C1MACROLET COMPILER::C1AND +- COMPILER::WT-VS-BASE COMPILER::ADD-LOOP-REGISTERS +- COMPILER::VAR-REGISTER COMPILER::C1PROGV COMPILER::C1SWITCH +- COMPILER::C1MEMBER COMPILER::C2TAGBODY-CLB +- COMPILER::CMP-MACROEXPAND-1 COMMON-LISP::PROCLAIM +- COMPILER::C1ASH-CONDITION COMPILER::C1EVAL-WHEN +- COMPILER::C1LOCAL-CLOSURE COMPILER::REPLACE-CONSTANT)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- COMPILER::INLINE-BOOLE3)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::*) +- COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL +- COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE)) ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ COMPILER::MLIN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- COMPILER::WT-INLINE COMPILER::C2IF COMPILER::C2LABELS +- COMPILER::C2FLET)) ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ COMPILER::DASH-TO-UNDERSCORE-INT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMPILER::T3DEFUN-AUX)) ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*)) ++ COMMON-LISP::T) ++ COMPILER::TS COMPILER::DASH-TO-UNDERSCORE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- COMPILER::F-TYPE)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ COMPILER::C1NIL COMPILER::WT-DATA-FILE ++ COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-NEXT-VAR-ARG ++ COMPILER::RESET-TOP COMPILER::VS-PUSH COMPILER::BABOON ++ COMPILER::GAZONK-NAME COMPILER::PRINT-COMPILER-INFO ++ COMPILER::ADD-LOAD-TIME-SHARP-COMMA COMPILER::INIT-ENV ++ COMPILER::PRINT-CURRENT-FORM COMPILER::WT-C-PUSH COMPILER::C1T ++ COMPILER::WT-FIRST-VAR-ARG COMPILER::CCB-VS-PUSH ++ COMPILER::INC-INLINE-BLOCKS COMPILER::WT-CVARS ++ COMPILER::WT-FASD-DATA-FILE COMPILER::WFS-ERROR ++ COMPILER::WT-DATA-END COMPILER::TAIL-RECURSION-POSSIBLE ++ COMPILER::CVS-PUSH COMPILER::WT-DATA-BEGIN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T) +- COMPILER::DASH-TO-UNDERSCORE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ COMPILER::ANALYZE-REGS1 COMPILER::ANALYZE-REGS ++ COMPILER::PROCLAIMED-ARGD)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::INIT-NAME COMPILER::ADD-INIT COMPILER::C1LAMBDA-EXPR +- COMPILER::WT-CVAR COMPILER::C1CASE COMPILER::WT-COMMENT +- COMPILER::CMPERR COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE +- COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::UNWIND-EXIT +- COMPILER::CMPWARN)) ++ COMPILER::CHECK-FNAME-ARGS COMPILER::COERCE-LOC ++ COMPILER::TYPE>= COMPILER::C2BIND-LOC ++ COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::ADD-DEBUG-INFO ++ COMPILER::MAKE-USER-INIT COMPILER::CO1EQL COMPILER::C2ASSOC!2 ++ COMPILER::WT-VAR COMPILER::CFAST-WRITE COMPILER::C2STACK-LET ++ COMPILER::C2DM-BIND-INIT COMPILER::IS-REP-REFERRED ++ COMPILER::CO1CONS COMPILER::SHIFT<< ++ COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C2CALL-LOCAL ++ COMPILER::CO1SCHAR COMPILER::C1CONSTANT-VALUE ++ COMPILER::WT-CHARACTER-VALUE COMPILER::CONVERT-CASE-TO-SWITCH ++ COMPILER::C2MULTIPLE-VALUE-CALL COMPILER::C2EXPR-TOP ++ COMPILER::CO1READ-BYTE COMPILER::PRIN1-CMP ++ COMPILER::STRUCT-TYPE-OPT COMPILER::C1DECL-BODY ++ COMPILER::COERCE-LOC-STRUCTURE-REF ++ COMPILER::CO1STRUCTURE-PREDICATE COMPILER::WT-MAKE-DCLOSURE ++ COMPILER::ARGS-INFO-CHANGED-VARS ++ COMPILER::C2LIST-NTH-IMMEDIATE COMPILER::CO1LDB ++ COMPILER::CO1WRITE-BYTE COMPILER::C1PROGN* ++ COMPILER::CO1CONSTANT-FOLD COMPILER::SET-JUMP-TRUE ++ COMPILER::C1SETQ1 COMPILER::CO1READ-CHAR COMPILER::C2BIND-INIT ++ COMPILER::CO1TYPEP COMPILER::WT-FIXNUM-VALUE ++ COMPILER::MULTIPLE-VALUE-CHECK COMPILER::SHIFT>> ++ COMPILER::CO1SUBLIS COMPILER::DO-MACRO-EXPANSION ++ COMPILER::C2UNWIND-PROTECT COMPILER::C2CALL-LAMBDA ++ COMPILER::C2MEMBER!2 COMPILER::GET-INLINE-LOC ++ COMPILER::C1LAMBDA-FUN COMPILER::JUMPS-TO-P COMPILER::C1EXPR* ++ COMPILER::C2SETQ COMPILER::C2APPLY COMPILER::UNWIND-BDS ++ COMPILER::SET-BDS-BIND COMPILER::NEED-TO-PROTECT ++ COMPILER::C1FMLA COMPILER::TYPE-AND COMPILER::CMPFIX-ARGS ++ COMPILER::MAYBE-EVAL COMPILER::C2BLOCK-CLB COMPILER::SET-DBIND ++ COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY ++ COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2DM-BIND-VL ++ COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::T3SHARP-COMMA ++ COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES COMPILER::C2CATCH ++ COMPILER::C2EXPR-TOP* COMPILER::SET-JUMP-FALSE ++ COMPILER::CO1VECTOR-PUSH COMPILER::WT-V*-MACROS ++ COMPILER::ARGS-INFO-REFERRED-VARS COMPILER::SET-VS ++ COMPILER::WT-REQUIREDS COMPILER::C2RETURN-CCB ++ COMPILER::C2THROW COMPILER::CHECK-END ++ COMPILER::PUSH-CHANGED-VARS COMPILER::C2BLOCK-CCB ++ SYSTEM::ADD-DEBUG COMPILER::C2PSETQ COMPILER::C1ARGS ++ COMPILER::COMPILER-CC COMPILER::INLINE-PROC ++ COMPILER::CO1WRITE-CHAR COMPILER::COMPILER-DEF-HOOK ++ COMPILER::CAN-BE-REPLACED COMPILER::C2MULTIPLE-VALUE-PROG1 ++ COMPILER::C2DM-BIND-LOC COMPILER::ADD-INFO ++ COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2LAMBDA-EXPR-WITH-KEY ++ COMPILER::FAST-READ COMPILER::C2RETURN-CLB ++ COMPILER::PROCLAIM-VAR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) +- COMPILER::C2RETURN-LOCAL COMPILER::C2BLOCK-LOCAL +- COMPILER::NCONC-FILES COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK +- COMPILER::C1BODY COMPILER::COMPILER-BUILD +- COMPILER::C2DECL-BODY COMPILER::WT-INLINE-LOC)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(COMPILER::CMP-ANON COMMON-LISP::COMPILE COMPILER::CMP-TMP-MACRO +- COMMON-LISP::DISASSEMBLE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T) +- COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM +- COMMON-LISP::T) +- COMMON-LISP::FIXNUM) +- COMPILER::BSEARCHLEQ)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T) +- COMMON-LISP::FIXNUM COMMON-LISP::T) +- COMMON-LISP::FIXNUM) +- COMPILER::PUSH-ARRAY)) ++ COMPILER::COMPILE-FILE1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::AND-FORM-TYPE COMPILER::SET-VAR COMPILER::C2LET* +- COMPILER::COMPILER-PASS2 COMPILER::ADD-FUNCTION-DECLARATION +- COMPILER::BOOLE3 COMPILER::C1MAP-FUNCTIONS +- COMPILER::TOO-MANY-ARGS COMPILER::CHECK-FORM-TYPE +- COMPILER::C2LET COMPILER::C-FUNCTION-NAME +- COMPILER::WT-INLINE-SHORT-FLOAT COMPILER::FIX-DOWN-ARGS +- COMPILER::C2PRINC COMPILER::WT-IF-PROCLAIMED +- COMPILER::ADD-FAST-LINK COMPILER::C2MULTIPLE-VALUE-BIND +- COMPILER::C2MAPCAN COMPILER::CJT COMPILER::CHECK-VDECL +- COMPILER::INLINE-TYPE-MATCHES COMPILER::WT-INLINE-LONG-FLOAT +- COMPILER::C2GO COMPILER::CAN-BE-REPLACED* COMPILER::MYSUB +- COMPILER::ASSIGN-DOWN-VARS COMPILER::C2MAPC +- COMPILER::WT-INLINE-INTEGER COMPILER::GET-INLINE-INFO +- COMPILER::CJF COMPILER::TOO-FEW-ARGS COMPILER::T3DEFCFUN +- COMPILER::CMP-EXPAND-MACRO COMPILER::WT-MAKE-CCLOSURE +- COMPILER::C2FUNCALL-SFUN COMPILER::C1DM +- COMPILER::WT-INLINE-COND COMPILER::C2TAGBODY +- COMPILER::WT-INLINE-CHARACTER COMPILER::C2PROGV +- COMPILER::C2MAPCAR COMPILER::C1STRUCTURE-REF1 COMPILER::C2CASE +- COMPILER::ADD-FUNCTION-PROCLAMATION +- COMPILER::MAKE-INLINE-STRING COMPILER::SUBLIS1-INLINE +- COMPILER::WT-INLINE-FIXNUM)) ++ COMPILER::MAKE-INLINE-STRING COMPILER::GET-INLINE-INFO ++ COMPILER::C1STRUCTURE-REF1 COMPILER::CJF COMPILER::SET-VAR ++ COMPILER::CHECK-FORM-TYPE COMPILER::AND-FORM-TYPE ++ COMPILER::SUBLIS1-INLINE COMPILER::T3DEFCFUN ++ COMPILER::WT-INLINE-INTEGER COMPILER::C-FUNCTION-NAME ++ COMPILER::FIX-DOWN-ARGS COMPILER::ASSIGN-DOWN-VARS ++ COMPILER::WT-INLINE-FIXNUM COMPILER::C2GO COMPILER::CJT ++ COMPILER::TOO-FEW-ARGS COMPILER::C2PRINC COMPILER::C2CASE ++ COMPILER::C2LET* COMPILER::BOOLE3 COMPILER::COMPILER-PASS2 ++ COMPILER::C1DM COMPILER::CHECK-VDECL COMPILER::C2LET ++ COMPILER::MYSUB COMPILER::CAN-BE-REPLACED* ++ COMPILER::ADD-FUNCTION-PROCLAMATION COMPILER::WT-IF-PROCLAIMED ++ COMPILER::C1MAP-FUNCTIONS COMPILER::ADD-FAST-LINK ++ COMPILER::WT-INLINE-LONG-FLOAT COMPILER::TOO-MANY-ARGS ++ COMPILER::C2MULTIPLE-VALUE-BIND COMPILER::C2PROGV ++ COMPILER::WT-INLINE-CHARACTER ++ COMPILER::ADD-FUNCTION-DECLARATION COMPILER::CMP-EXPAND-MACRO ++ COMPILER::C2MAPCAR COMPILER::INLINE-TYPE-MATCHES ++ COMPILER::C2FUNCALL-SFUN COMPILER::WT-MAKE-CCLOSURE ++ COMPILER::C2MAPCAN COMPILER::C2TAGBODY ++ COMPILER::WT-INLINE-COND COMPILER::C2MAPC ++ COMPILER::WT-INLINE-SHORT-FLOAT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK +- COMPILER::INLINE-ARGS)) ++ COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::C2STRUCTURE-REF COMPILER::WT-GLOBAL-ENTRY +- COMPILER::T3DEFUN-VARARG COMPILER::T3DEFUN-NORMAL +- COMPILER::C2CALL-GLOBAL COMPILER::C1MAKE-VAR +- COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::C2SWITCH +- COMPILER::T3INIT-FUN COMPILER::MY-CALL)) ++ COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY COMPILER::T2DEFENTRY ++ COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO COMPILER::T2DEFENTRY +- COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY)) ++ COMPILER::T3DEFUN COMPILER::T3DEFUN-LOCAL-ENTRY ++ COMPILER::C2STRUCTURE-SET COMPILER::T2DEFUN ++ COMPILER::C1APPLY-OPTIMIZE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::T2DEFUN COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN +- COMPILER::C2STRUCTURE-SET COMPILER::T3DEFUN-LOCAL-ENTRY)) ++ COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL ++ COMPILER::INLINE-ARGS COMPILER::LINK)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ COMMON-LISP::T) + COMMON-LISP::T) +- COMPILER::WT-SIMPLE-CALL COMPILER::GET-OUTPUT-PATHNAME)) ++ COMPILER::T3INIT-FUN COMPILER::C2STRUCTURE-REF ++ COMPILER::WT-GLOBAL-ENTRY COMPILER::T3DEFUN-NORMAL ++ COMPILER::T3DEFUN-VARARG COMPILER::C1MAKE-VAR ++ COMPILER::C2SWITCH COMPILER::MY-CALL COMPILER::C2CALL-GLOBAL ++ COMPILER::C2CALL-UNKNOWN-GLOBAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) ++ COMPILER::GET-OUTPUT-PATHNAME COMPILER::WT-SIMPLE-CALL)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(COMPILER::CMP-ANON COMMON-LISP::COMPILE COMPILER::CMP-TMP-MACRO ++ COMMON-LISP::DISASSEMBLE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ COMPILER::MAKE-VAR COMPILER::COMPILER-COMMAND ++ COMPILER::LIST*-INLINE COMMON-LISP::COMPILE-FILE ++ COMPILER::CS-PUSH COMPILER::MAKE-INFO COMPILER::FCALLN-INLINE ++ COMPILER::C2FSET COMPILER::MAKE-TAG COMPILER::WT-CLINK ++ COMPILER::LIST-INLINE COMPILER::MAKE-FUN COMPILER::MAKE-BLK)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2EXPR +- COMPILER::WT-FIXNUM-LOC COMPILER::WT-CHARACTER-LOC +- COMPILER::C2AND COMPILER::T1EXPR COMPILER::CMP-TOPLEVEL-EVAL +- COMPILER::WT-SHORT-FLOAT-LOC COMPILER::C2OR COMPILER::WT-LOC +- COMPILER::CMP-EVAL COMPILER::T1EVAL-WHEN COMPILER::SET-LOC +- COMPILER::VV-STR COMPILER::WT-TO-STRING)) ++ COMPILER::T1EVAL-WHEN COMPILER::T1EXPR ++ COMPILER::WT-CHARACTER-LOC COMPILER::SET-LOC ++ COMPILER::CMP-TOPLEVEL-EVAL COMPILER::C2PROGN ++ COMPILER::WT-TO-STRING COMPILER::MEXPAND-DEFTYPE ++ COMPILER::WT-SHORT-FLOAT-LOC COMPILER::CMP-EVAL ++ COMPILER::WT-LOC COMPILER::C2AND COMPILER::C2EXPR ++ COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2OR ++ COMPILER::WT-FIXNUM-LOC)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- COMPILER::MAKE-FUN COMPILER::MAKE-BLK +- COMMON-LISP::COMPILE-FILE COMPILER::FCALLN-INLINE +- COMPILER::MAKE-INFO COMPILER::CS-PUSH COMPILER::MAKE-VAR +- COMPILER::LIST-INLINE COMPILER::C2FSET COMPILER::WT-CLINK +- COMPILER::COMPILER-COMMAND COMPILER::MAKE-TAG +- COMPILER::LIST*-INLINE)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ COMPILER::LTVP-EVAL COMPILER::FSET-FN-NAME COMPILER::C1MAPCON ++ COMPILER::FUNCTION-ARG-TYPES COMPILER::C1SHARP-COMMA ++ COMPILER::SAVE-AVMA COMPILER::C2TAGBODY-CCB COMPILER::VAR-LOC ++ COMPILER::WT-DOWN COMPILER::C1SETQ COMPILER::TAG-REF-CCB ++ COMPILER::T1DEFINE-STRUCTURE COMPILER::SAVE-FUNOB ++ COMPILER::C1VAR COMPILER::VV-STR COMPILER::C1RPLACA ++ COMPILER::INFO-SP-CHANGE COMPILER::BLK-REF-CCB ++ COMPILER::T1ORDINARY COMPILER::FIXNUM-LOC-P ++ COMPILER::FUN-REF-CCB COMPILER::C2GET COMPILER::FUN-NAME ++ COMPILER::FUN-P COMPILER::SCH-GLOBAL COMPILER::C1LET ++ COMPILER::C2TAGBODY-CLB COMPILER::C1UNWIND-PROTECT ++ COMPILER::SET-RETURN COMPILER::WT-VAR-DECL ++ COMPILER::VAR-REGISTER COMPILER::C1DEFINE-STRUCTURE ++ COMPILER::LTVP COMPILER::INLINE-POSSIBLE COMPILER::CHECK-VREF ++ COMPILER::TAG-NAME COMPILER::C2DM-RESERVE-VL ++ COMPILER::VAR-TYPE COMPILER::WT-LIST COMPILER::C1LET* ++ COMPILER::VARARG-P COMPILER::C1LOAD-TIME-VALUE ++ COMPILER::C2FUNCALL-AUX COMPILER::INFO-TYPE COMPILER::C1GET ++ COMPILER::C1NTHCDR-CONDITION COMPILER::C1AND ++ COMPILER::C1MULTIPLE-VALUE-CALL COMPILER::C1RPLACA-NTHCDR ++ COMPILER::INFO-VOLATILE COMPILER::INLINE-TYPE ++ COMPILER::LONG-FLOAT-LOC-P COMPILER::INFO-CHANGED-ARRAY ++ SYSTEM::UNDEF-COMPILER-MACRO COMPILER::DECL-BODY-SAFETY ++ COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P COMPILER::C2BIND ++ COMPILER::C1DECLARE COMPILER::CONS-TO-LISTA ++ COMPILER::C1MULTIPLE-VALUE-SETQ COMPILER::NAME-SD1 ++ COMPILER::BLK-NAME COMPILER::PARSE-CVSPECS COMPILER::C1MAPL ++ COMPILER::AET-C-TYPE COMPILER::C2VAR COMPILER::COPY-INFO ++ COMPILER::C1PSETQ COMPILER::C1VREF COMPILER::FUN-REF ++ COMPILER::WT-H1 COMPILER::T1DEFCFUN COMPILER::T1PROGN ++ COMPILER::C1EVAL-WHEN COMPILER::FLAGS-POS COMPILER::WT-VS ++ COMPILER::C2VAR-KIND COMPILER::C1LENGTH ++ COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C2LOCATION ++ COMPILER::C2DM-RESERVE-V COMPILER::C2FUNCTION ++ COMPILER::WT-SWITCH-CASE COMPILER::C2TAGBODY-LOCAL ++ COMPILER::CONSTANT-FOLD-P COMPILER::NEED-TO-SET-VS-POINTERS ++ COMPILER::C1MAPCAN COMPILER::WT-FUNCALL-C COMPILER::WT-CCB-VS ++ COMPILER::C1RETURN-FROM COMPILER::GET-INCLUDED ++ COMPILER::C1BLOCK COMPILER::ADD-CONSTANT COMPILER::WT-VS-BASE ++ COMPILER::C1NTH-CONDITION COMPILER::FUN-LEVEL ++ COMPILER::UNWIND-NO-EXIT COMMON-LISP::PROCLAIM ++ COMPILER::C1PRINC COMPILER::C2EXPR* COMPILER::RESULT-TYPE ++ COMPILER::TAG-REF COMPILER::C1FUNCALL COMPILER::C1PROGN ++ COMPILER::MAXARGS COMPILER::UNDEFINED-VARIABLE COMPILER::C1THE ++ COMPILER::CMP-MACROEXPAND COMPILER::C1MAPCAR ++ COMPILER::DEFAULT-INIT COMPILER::C1STRUCTURE-SET ++ COMPILER::WT-SYMBOL-FUNCTION COMPILER::T1DEFUN ++ COMPILER::WT-DATA1 COMPILER::PUSH-DATA-INCF COMPILER::C1IF ++ COMPILER::C1NTHCDR COMPILER::ADD-SYMBOL ++ COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::BLK-REF ++ COMPILER::WT-FUNCTION-LINK COMPILER::INFO-P COMPILER::C1FSET ++ COMPILER::C1PROGV COMPILER::C1ASSOC COMPILER::VAR-REF ++ COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::MDELETE-FILE ++ COMPILER::CMP-MACRO-FUNCTION COMPILER::C2DOWNWARD-FUNCTION ++ COMPILER::C2GO-LOCAL COMPILER::T1DEFLA COMPILER::VAR-REF-CCB ++ COMPILER::C1FLET COMPILER::C1LIST-NTH ++ COMPILER::ADD-LOOP-REGISTERS COMPILER::INFO-REFERRED-ARRAY ++ COMPILER::BLK-VALUE-TO-GO COMPILER::WT-VS* ++ COMPILER::NAME-TO-SD COMPILER::C1RPLACD ++ COMPILER::WT-DATA-PACKAGE-OPERATION COMPILER::C1SWITCH ++ COMPILER::C1CATCH COMPILER::WT-CAR COMPILER::C1MACROLET ++ COMPILER::OBJECT-TYPE COMPILER::C1MAPC COMPILER::T1CLINES ++ COMPILER::C1COMPILER-LET COMPILER::CMP-MACROEXPAND-1 ++ COMPILER::C1TAGBODY COMPILER::C1MAPLIST COMPILER::PUSH-ARGS ++ COMPILER::T3ORDINARY COMPILER::C1MEMBER COMPILER::T1MACROLET ++ COMPILER::WT-CDR COMPILER::C1BOOLE3 COMPILER::PROCLAMATION ++ COMPILER::GET-LOCAL-RETURN-TYPE COMPILER::C1LOCAL-FUN ++ COMPILER::VAR-KIND COMPILER::WT1 COMPILER::TAG-SWITCH ++ COMPILER::C1OR COMPILER::C1STRUCTURE-REF ++ COMPILER::THE-PARAMETER COMPILER::VAR-REP-LOC ++ COMPILER::DECLARATION-TYPE COMPILER::TAG-P COMPILER::C2GETHASH ++ COMPILER::C1EXPR COMPILER::REPLACE-CONSTANT COMPILER::C1ECASE ++ COMPILER::FUN-CFUN COMPILER::SET-TOP COMPILER::TAG-LABEL ++ COMPILER::C1DM-BAD-KEY COMPILER::C1THROW COMPILER::C2GO-CCB ++ COMPILER::REP-TYPE COMPILER::C2VALUES ++ COMPILER::SHORT-FLOAT-LOC-P COMPILER::FUNCTION-RETURN-TYPE ++ COMPILER::ADD-OBJECT COMPILER::CTOP-WRITE COMPILER::C1MEMQ ++ COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::C1TERPRI ++ COMPILER::T1DEFMACRO COMPILER::T3CLINES COMPILER::ADD-REG1 ++ COMPILER::C1NTH COMPILER::C1ASH COMPILER::C1FMLA-CONSTANT ++ COMPILER::C2GO-CLB COMPILER::WT-CADR ++ COMPILER::C1BOOLE-CONDITION COMPILER::CLINK COMPILER::VAR-NAME ++ COMPILER::PUSH-ARGS-LISPCALL COMPILER::GET-ARG-TYPES ++ COMPILER::BLK-VAR COMPILER::C1APPLY COMPILER::CHECK-DOWNWARD ++ COMPILER::C1QUOTE COMPILER::TAG-REF-CLB ++ COMPILER::GET-LOCAL-ARG-TYPES COMPILER::REGISTER ++ COMPILER::BLK-P COMPILER::FUN-INFO COMPILER::C2RPLACD ++ COMPILER::ADD-OBJECT2 COMPILER::C2TAGBODY-BODY ++ COMPILER::T1DEFENTRY COMPILER::C1FUNCTION ++ COMPILER::C1DOWNWARD-FUNCTION COMPILER::SAFE-SYSTEM ++ COMPILER::C1GO COMPILER::BLK-EXIT COMPILER::VERIFY-DATA-VECTOR ++ COMPILER::C2RPLACA COMPILER::T2DECLARE COMPILER::MACRO-DEF-P ++ COMPILER::C1LABELS COMPILER::C1GETHASH COMPILER::FIX-OPT ++ COMPILER::SCH-LOCAL-FUN COMPILER::C1FUNOB ++ COMPILER::SET-PUSH-CATCH-FRAME COMPILER::GET-RETURN-TYPE ++ COMPILER::SET-UP-VAR-CVS COMPILER::TAG-UNWIND-EXIT ++ COMPILER::VAR-P COMPILER::C1ADD-GLOBALS COMPILER::TYPE-FILTER ++ COMPILER::WT-VV COMPILER::C1ASH-CONDITION COMPILER::VOLATILE ++ COMPILER::INLINE-BOOLE3-STRING COMPILER::C1LOCAL-CLOSURE ++ COMPILER::WRITE-BLOCK-OPEN COMPILER::ADD-ADDRESS ++ COMPILER::RESET-INFO-TYPE COMPILER::C1VALUES ++ COMPILER::BLK-REF-CLB COMPILER::C1STACK-LET)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ COMPILER::INLINE-BOOLE3)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION ((COMMON-LISP::VECTOR COMMON-LISP::T)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- COMPILER::COPY-ARRAY)) ++ COMPILER::MEMOIZED-HASH-EQUAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::WT-INLINE-LOC COMPILER::NCONC-FILES ++ COMPILER::COMPILER-BUILD COMPILER::C2BLOCK-LOCAL ++ COMPILER::C2DECL-BODY COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK ++ COMPILER::C1BODY COMPILER::C2RETURN-LOCAL)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMPILER::C2EXPR-TOP COMPILER::CO1SUBLIS +- COMPILER::C2CALL-LAMBDA COMPILER::GET-INLINE-LOC +- COMPILER::CHECK-END COMPILER::C2PSETQ COMPILER::TYPE-AND +- COMPILER::TYPE>= COMPILER::C2MULTIPLE-VALUE-PROG1 +- COMPILER::CO1SCHAR SYSTEM::ADD-DEBUG COMPILER::C2BLOCK-CCB +- COMPILER::C2DM-BIND-VL COMPILER::MAKE-USER-INIT +- COMPILER::NEED-TO-PROTECT COMPILER::FAST-READ +- COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::C2BIND-INIT +- COMPILER::JUMPS-TO-P COMPILER::C2MEMBER!2 +- COMPILER::C2CALL-LOCAL COMPILER::C2BLOCK-CLB +- COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::INLINE-PROC +- COMPILER::C2THROW COMPILER::C1DECL-BODY +- COMPILER::WT-MAKE-DCLOSURE COMPILER::CO1WRITE-CHAR +- COMPILER::C1SETQ1 COMPILER::SET-JUMP-FALSE COMPILER::CO1CONS +- COMPILER::CO1VECTOR-PUSH COMPILER::SET-VS COMPILER::SHIFT>> +- COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::WT-FIXNUM-VALUE +- COMPILER::C2CATCH COMPILER::C2RETURN-CCB COMPILER::MAYBE-EVAL +- COMPILER::C2ASSOC!2 COMPILER::C2DM-BIND-INIT +- COMPILER::C2STACK-LET COMPILER::C2LAMBDA-EXPR-WITH-KEY +- COMPILER::ARGS-INFO-REFERRED-VARS +- COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C1PROGN* +- COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2MULTIPLE-VALUE-CALL +- COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::CO1CONSTANT-FOLD +- COMPILER::C1CONSTANT-VALUE COMPILER::C1EXPR* +- COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2RETURN-CLB +- COMPILER::CMPFIX-ARGS COMPILER::PROCLAIM-VAR COMPILER::C2APPLY +- COMPILER::DO-MACRO-EXPANSION COMPILER::CFAST-WRITE +- COMPILER::PRIN1-CMP COMPILER::SHIFT<< COMPILER::WT-REQUIREDS +- COMPILER::C2EXPR-TOP* COMPILER::UNWIND-BDS +- COMPILER::MULTIPLE-VALUE-CHECK COMPILER::COERCE-LOC +- COMPILER::STRUCT-TYPE-OPT COMPILER::CO1READ-CHAR +- COMPILER::ADD-DEBUG-INFO COMPILER::C2LIST-NTH-IMMEDIATE +- COMPILER::WT-VAR COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY +- COMPILER::CHECK-FNAME-ARGS COMPILER::CAN-BE-REPLACED +- COMPILER::WT-CHARACTER-VALUE COMPILER::C2UNWIND-PROTECT +- COMPILER::SET-DBIND COMPILER::T3SHARP-COMMA +- COMPILER::IS-REP-REFERRED COMPILER::C1FMLA +- COMPILER::WT-V*-MACROS COMPILER::C2DM-BIND-LOC +- COMPILER::C2BIND-LOC +- COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES +- COMPILER::ADD-INFO COMPILER::C2SETQ +- COMPILER::PUSH-CHANGED-VARS COMPILER::CO1STRUCTURE-PREDICATE +- COMPILER::SET-BDS-BIND COMPILER::SET-JUMP-TRUE +- COMPILER::CO1READ-BYTE COMPILER::C1LAMBDA-FUN +- COMPILER::CO1TYPEP COMPILER::CONVERT-CASE-TO-SWITCH +- COMPILER::COMPILER-DEF-HOOK COMPILER::CO1LDB COMPILER::C1ARGS +- COMPILER::CO1WRITE-BYTE COMPILER::CO1EQL +- COMPILER::COMPILER-CC)) ++ COMPILER::C1LAMBDA-EXPR COMPILER::CMPWARN COMPILER::ADD-INIT ++ COMPILER::UNWIND-EXIT COMPILER::CMPNOTE COMPILER::CMPERR ++ COMPILER::C1CASE COMPILER::WT-COMMENT COMPILER::INIT-NAME ++ COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::WT-INTEGER-LOC ++ COMPILER::WT-CVAR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) COMMON-LISP::T) +- COMPILER::MLIN)) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ COMPILER::C2IF COMPILER::WT-INLINE COMPILER::C2COMPILER-LET ++ COMPILER::C2FLET COMPILER::C2LABELS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::*) +- COMPILER::COMPILE-FILE1)) ++ COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE ++ COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- COMPILER::WT-DATA-BEGIN COMPILER::WT-C-PUSH COMPILER::WT-CVARS +- COMPILER::C1T COMPILER::CVS-PUSH COMPILER::WT-DATA-FILE +- COMPILER::ADD-LOAD-TIME-SHARP-COMMA +- COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-FASD-DATA-FILE +- COMPILER::GAZONK-NAME COMPILER::WFS-ERROR +- COMPILER::WT-NEXT-VAR-ARG COMPILER::WT-FIRST-VAR-ARG +- COMPILER::C1NIL COMPILER::WT-DATA-END COMPILER::RESET-TOP +- COMPILER::TAIL-RECURSION-POSSIBLE +- COMPILER::PRINT-COMPILER-INFO COMPILER::CCB-VS-PUSH +- COMPILER::BABOON COMPILER::INIT-ENV +- COMPILER::PRINT-CURRENT-FORM COMPILER::VS-PUSH +- COMPILER::INC-INLINE-BLOCKS)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMPILER::T3DEFUN-AUX)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::FIXNUM) ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*))) + COMMON-LISP::T) +- COMPILER::MEMOIZED-HASH-EQUAL)) ++ COMPILER::COPY-ARRAY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T ++ (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T) + COMMON-LISP::FIXNUM) +- COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1 +- COMPILER::ANALYZE-REGS)) ++ COMPILER::BSEARCHLEQ)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::STRING COMMON-LISP::FIXNUM +- COMMON-LISP::FIXNUM) +- COMMON-LISP::T) +- COMPILER::DASH-TO-UNDERSCORE-INT)) +\ No newline at end of file ++ (COMMON-LISP::T ++ (COMMON-LISP::ARRAY COMMON-LISP::T (COMMON-LISP::*)) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ COMPILER::PUSH-ARRAY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ COMPILER::F-TYPE)) +\ No newline at end of file +--- gcl-2.6.12.orig/configure ++++ gcl-2.6.12/configure +@@ -3980,7 +3980,7 @@ add_args_to_cflags -fsigned-char -pipe \ + -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ + -Wno-unused-but-set-variable -Wno-misleading-indentation + +-add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++add_args_to_ldflags -no-pie -Wl,-z,lazy + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 + $as_echo_n "checking for clang... " >&6; } +--- gcl-2.6.12.orig/configure.in ++++ gcl-2.6.12/configure.in +@@ -264,7 +264,7 @@ add_args_to_cflags -fsigned-char -pipe \ + -Wno-builtin-requires-header -Wno-empty-body -Wno-self-assign \ + -Wno-unused-but-set-variable -Wno-misleading-indentation + +-add_args_to_ldflags -Wl,-no_pie -no-pie -Wl,-z,lazy ++add_args_to_ldflags -no-pie -Wl,-z,lazy + + AC_MSG_CHECKING([for clang]) + AC_RUN_IFELSE( +--- gcl-2.6.12.orig/gcl-tk/socketsl.lisp ++++ gcl-2.6.12/gcl-tk/socketsl.lisp +@@ -12,10 +12,6 @@ + (defentry our-write (int object int ) (int "our_write_object")) + (defentry print-to-string1 (object object object) (object print_to_string1)) + +-(clines "#define reset_string_input_stream1(strm,string,start,end) reset_string_input_stream(strm,string,fix(start),fix(end))") +-(defentry reset-string-input-stream (object object object object) (object "reset_string_input_stream1")) +- +- + ;(clines "#define symbol_value_any(x) ((x)->s.s_dbind)") + ;(defentry symbol-value-any (object) (object symbol_value_any)) + +--- gcl-2.6.12.orig/gcl-tk/tkl.lisp ++++ gcl-2.6.12/gcl-tk/tkl.lisp +@@ -293,6 +293,9 @@ + (let () + (send-tcl-cmd *tk-connection* tk-command nil)))) + ++(defun fsubseq (s &optional (b 0) (e (length s))) ++ (make-array (- e b) :element-type (array-element-type s) :displaced-to s :displaced-index-offset b :fill-pointer (- e b))) ++ + (defun send-tcl-cmd (c str send-and-wait ) + ;(notice-text-variables) + (or send-and-wait (setq send-and-wait *send-and-wait*)) +@@ -308,7 +311,7 @@ + + (cond (send-and-wait + (if *debugging* +- (store-circle *requests* (subseq str #.(length *header*)) ++ (store-circle *requests* (fsubseq str #.(length *header*)) + msg-id)) + (store-circle *replies* nil msg-id) + (execute-tcl-cmd c str)) +@@ -932,7 +935,7 @@ + #.(+ 1 (length *header*)) + 3)) + (values +- (subseq str #.(+ 4 (length *header*))) ++ (fsubseq str #.(+ 4 (length *header*))) + (eql (aref str #.(+ 1 (length *header*))) #\0) + reply-from + (get-circle *requests* reply-from))) +@@ -1082,7 +1085,7 @@ + (store-circle *replies* + (cons success + (if (eql (length tk-command) #.(+ 4 (length *header*))) "" +- (subseq tk-command #.(+ 4 (length *header*))))) ++ (fsubseq tk-command #.(+ 4 (length *header*))))) + from-id)) + (#.(pos m_call *mtypes*) + ;; Can play a game of if read-and-act called with request-id: +@@ -1114,7 +1117,7 @@ + (var (aref *text-variable-locations* lisp-var-id)) + (type (get var 'linked-variable-type)) + val) +- (setq val (coerce-result (subseq tk-command #.(+ 3 (length *header*))) type)) ++ (setq val (coerce-result (fsubseq tk-command #.(+ 3 (length *header*))) type)) + (setf (aref *text-variable-locations* (the fixnum + ( + lisp-var-id 1))) + val) +@@ -1130,7 +1133,9 @@ + (let* ((s (car *string-streams*)) + (*string-streams* (cdr *string-streams*))) + (or s (setq s (make-string-input-stream ""))) +- (si::reset-string-input-stream s string start (length string)) ++ (assert (array-has-fill-pointer-p string)) ++ (setf (fill-pointer string) start) ++ (si::c-set-stream-object0 s string) + (read s nil nil))) + + +@@ -1196,7 +1201,7 @@ + (cond (skipping nil) + ((eql brace-level 0) + (if (> i beg) +- (setq ans (cons (subseq x beg i) ans))) ++ (setq ans (cons (fsubseq x beg i) ans))) + + (setq beg (+ i 1)) + ))) +@@ -1207,12 +1212,12 @@ + (setq beg (+ i 1)))) + (incf brace-level)) + (#\} (cond ((eql brace-level 1) +- (setq ans (cons (subseq x beg i) ans)) ++ (setq ans (cons (fsubseq x beg i) ans)) + (setq skipping t))) + (incf brace-level -1))))) + finally + (unless skipping +- (setq ans (cons (subseq x beg i) ans))) ++ (setq ans (cons (fsubseq x beg i) ans))) + (return (nreverse ans)) + )) + +@@ -1394,7 +1399,7 @@ + (cond (start (pp v no_leading_space) (setq start nil)) + (t (pp v normal))) + (setf x (cdr x))) +- (subseq tk-command #.(length *header*)))) ++ (fsubseq tk-command #.(length *header*)))) + + + +@@ -1409,7 +1414,6 @@ + (setq gcltksrv + (cond (host "gcltksrv") + ((si::getenv "GCL_TK_SERVER")) +- ((probe-file (tk-conc si::*lib-directory* "/gcl-tk/gcltksrv"))) + ((probe-file (tk-conc si::*lib-directory* "gcl-tk/gcltksrv"))) + (t (error "Must setenv GCL_TK_SERVER "))))) + (let ((pid (if host -1 (si::getpid))) +@@ -1427,9 +1431,9 @@ + args + ))) + (print command) +- (cond ((not host) (system command)) ++ (cond ((not host) (si::system command)) + (can-rsh +- (system (tk-conc "rsh " host " " command ++ (si::system (tk-conc "rsh " host " " command + " < /dev/null &"))) + (t (format t "Waiting for you to invoke GCL_TK_SERVER, + on ~a as in: ~s~%" host command ))) +--- gcl-2.6.12.orig/h/compprotos.h ++++ gcl-2.6.12/h/compprotos.h +@@ -180,3 +180,4 @@ char *gcl_gets(char *,int); + int gcl_puts(const char *); + int endp_error(object); + object Icall_gen_error_handler(object,object,object,object,ufixnum,...); ++object file_stream(object); +--- gcl-2.6.12.orig/h/lu.h ++++ gcl-2.6.12/h/lu.h +@@ -271,15 +271,14 @@ struct structure { + + struct stream { + FIRSTWORD; +- void *sm_fp; +- object sm_object0; +- object sm_object1; +- int sm_int0; +- int sm_int1; +- char *sm_buffer; +- char sm_mode; +- unsigned char sm_flags; +- short sm_fd; ++ void *sm_fp; ++ object sm_object0; ++ object sm_object1; ++ char *sm_buffer; ++ ufixnum sm_mode:4; ++ ufixnum sm_flags:6; ++ ufixnum sm_fd:6; ++ ufixnum sm_int:LM(16); + }; + + struct random { +--- gcl-2.6.12.orig/h/object.h ++++ gcl-2.6.12/h/object.h +@@ -166,18 +166,18 @@ enum aelttype { /* array element type + /* for any stream that takes writec_char, directly (not two_way or echo) + ie. smm_output,smm_io, smm_string_output, smm_socket + */ +-#define STREAM_FILE_COLUMN(str) ((str)->sm.sm_int1) ++#define STREAM_FILE_COLUMN(str) ((str)->sm.sm_int) + + /* for smm_echo */ +-#define ECHO_STREAM_N_UNREAD(strm) ((strm)->sm.sm_int0) ++#define ECHO_STREAM_N_UNREAD(strm) ((strm)->sm.sm_int) + + /* file fd for socket */ + #define SOCKET_STREAM_FD(strm) ((strm)->sm.sm_fd) + #define SOCKET_STREAM_BUFFER(strm) ((strm)->sm.sm_object1) + + /* for smm_string_input */ +-#define STRING_INPUT_STREAM_NEXT(strm) ((strm)->sm.sm_int0) +-#define STRING_INPUT_STREAM_END(strm) ((strm)->sm.sm_int1) ++#define STRING_INPUT_STREAM_NEXT(strm) ((strm)->sm.sm_object0->st.st_fillp) ++#define STRING_INPUT_STREAM_END(strm) ((strm)->sm.sm_object0->st.st_dim) + + /* for smm_two_way and smm_echo */ + #define STREAM_OUTPUT_STREAM(strm) ((strm)->sm.sm_object1) +--- gcl-2.6.12.orig/h/type.h ++++ gcl-2.6.12/h/type.h +@@ -41,7 +41,6 @@ enum smmode { /* stream mode */ + smm_output, /* output */ + smm_io, /* input-output */ + smm_probe, /* probe */ +- smm_file_synonym, /* synonym stream to file_stream */ + smm_synonym, /* synonym */ + smm_broadcast, /* broadcast */ + smm_concatenated, /* concatenated */ +@@ -152,5 +151,4 @@ enum smmode { /* stream mode */ + #define pathname_string_symbol_streamp(a_) ({enum type _tp=type_of(a_); _tp==t_pathname || _tp == t_string\ + || _tp == t_symbol || _tp==t_stream;}) + +-#define pathname_designatorp(a_) ({object _a=(a_);enum type _tp=type_of(a_);\ +- _tp==t_pathname||_tp==t_string||(_tp==t_stream && _a->sm.sm_mode>=smm_input && _a->sm.sm_mode<=smm_file_synonym);}) ++#define pathname_designatorp(a_) ({object _a=(a_);enum type _tp=type_of(a_);_tp==t_pathname||_tp==t_string||file_stream(_a)!=Cnil;}) +--- gcl-2.6.12.orig/lsp/gcl_directory.lsp ++++ gcl-2.6.12/lsp/gcl_directory.lsp +@@ -74,4 +74,12 @@ + (let ((r (with-open-file (s (apply 'string-concatenate "|" #-winnt "which " + #+winnt "for %i in (" s #+winnt ".exe) do @echo.%~$PATH:i" nil)) + (read-line s nil 'eof)))) +- (if (eq r 'eof) s (string-downcase r)))) ++ (unless (eq r 'eof) ++ (string-downcase r)))) ++ ++(defun get-path (s &aux ++ (e (unless (minusp (string-match #v"([^\n\t\r ]+)([\n\t\r ]|$)" s))(match-end 1))) ++ (w (when e (which (pathname-name (subseq s (match-beginning 1) e)))))) ++ (when w ++ (string-concatenate w (subseq s e)))) ++ +--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp ++++ gcl-2.6.12/lsp/gcl_iolib.lsp +@@ -69,7 +69,20 @@ + (progn ,@b) + (close ,var))))) + +-(defmacro with-input-from-string ((var string &key index start end) . body) ++(defun make-string-input-stream (string &optional (start 0) end) ++ (declare (optimize (safety 1))) ++ (check-type string string) ++ (check-type start seqind) ++ (check-type end (or null seqind)) ++ (let ((l (- (or end (length string)) start))) ++ (make-string-input-stream-int ++ (make-array l :element-type (array-element-type string) :displaced-to string :displaced-index-offset start :fill-pointer 0) ++ 0 l))) ++ ++(defun get-string-input-stream-index (stream &aux (s (c-stream-object0 stream))) ++ (+ (fill-pointer s) (multiple-value-bind (a b) (array-displacement s) b))) ++ ++(defmacro with-input-from-string ((var string &key index (start 0) end) . body) + (declare (optimize (safety 1))) + (multiple-value-bind (ds b) (find-declarations body) + `(let ((,var (make-string-input-stream ,string ,start ,end))) +@@ -77,7 +90,8 @@ + (unwind-protect + (multiple-value-prog1 + (progn ,@b) +- ,@(when index `((setf ,index (get-string-input-stream-index ,var))))) ++ ,@(when index ++ `((setf ,index (get-string-input-stream-index ,var))))) + (close ,var))))) + + (defmacro with-output-to-string ((var &optional string &key element-type) . body) +@@ -406,7 +420,7 @@ + + + (defun write-sequence (seq strm &rest r &key (start 0) end +- &aux (l (listp seq))(cp (eq (stream-element-type strm) 'character))) ++ &aux (cp (eq (stream-element-type strm) 'character))) + (declare (optimize (safety 1))(dynamic-extent r)) + (check-type seq sequence) + (check-type strm stream) +@@ -443,9 +457,15 @@ + if-exists iesp if-does-not-exist idnesp external-format))) + (when (typep s 'stream) (c-set-stream-object1 s pf) s))) + ++(defun load-pathname-exists (z) ++ (or (probe-file z) ++ (when *allow-gzipped-file* ++ (when (probe-file (string-concatenate (namestring z) ".gz")) ++ z)))) ++ + (defun load-pathname (p print if-does-not-exist external-format + &aux (pp (merge-pathnames p)) +- (epp (reduce (lambda (y x) (or y (probe-file (translate-pathname x "" p)))) ++ (epp (reduce (lambda (y x) (or y (load-pathname-exists (translate-pathname x "" p)))) + '(#P".o" #P".lsp" #P".lisp" #P"") :initial-value nil)));FIXME newest? + (if epp + (let* ((*load-pathname* pp)(*load-truename* epp)) +@@ -484,3 +504,36 @@ + (d pd (cdr pd))) + (values ps created))) + ++(defun file-length (x) ++ (declare (optimize (safety 1))) ++ (check-type x (or broadcast-stream file-stream)) ++ (if (typep x 'broadcast-stream) ++ (let ((s (broadcast-stream-streams x))) (if s (file-length (car (last s))) 0)) ++ (multiple-value-bind (tp sz) (stat x) ++ (declare (ignore tp)) ++ (/ sz (get-byte-stream-nchars x))))) ++ ++(defun file-position (x &optional (pos :start pos-p)) ++ (declare (optimize (safety 1))) ++ (check-type x (or broadcast-stream file-stream string-stream)) ++ (check-type pos (or (member :start :end) (integer 0))) ++ (typecase x ++ (broadcast-stream ++ (let ((s (car (last (broadcast-stream-streams x))))) ++ (if s (if pos-p (file-position s pos) (file-position s)) 0))) ++ (string-stream ++ (let* ((st (c-stream-object0 x))(l (length st))(d (array-dimension st 0)) ++ (p (case pos (:start 0) (:end l) (otherwise pos)))) ++ (if pos-p (when (<= p d) (setf (fill-pointer st) p)) l))) ++ (otherwise ++ (let ((n (get-byte-stream-nchars x)) ++ (p (case pos (:start 0) (:end (file-length x)) (otherwise pos)))) ++ (if pos-p (when (fseek x (* p n)) p) (/ (ftell x) n)))))) ++ ++(defun file-string-length (strm obj) ++ (let* ((pos (file-position strm)) ++ (w (write obj :stream strm :escape nil :readably nil)) ++ (pos1 (file-position strm)));(break) ++ (declare (ignore w)) ++ (file-position strm pos) ++ (- pos1 pos))) +--- gcl-2.6.12.orig/lsp/gcl_namestring.lsp ++++ gcl-2.6.12/lsp/gcl_namestring.lsp +@@ -27,7 +27,7 @@ + (declare (optimize (safety 1))) + (check-type x pathname-designator) + (check-type def pathname-designator) +- ,(labels ((new? (k &aux (f (intern (concatenate 'string "PATHNAME-" (string k)) :si))) ++ ,(labels ((new? (k &aux (f (intern (string-concatenate "PATHNAME-" (string k)) :si))) + `(let ((k (,f px))) (unless (equal k (,f pdef)) k)))) + `(namestring (make-pathname + ,@(mapcan (lambda (x) (list x (new? x))) +pathname-keys+))))) +--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp ++++ gcl-2.6.12/lsp/gcl_predlib.lsp +@@ -125,6 +125,8 @@ + (character . characterp) + (package . packagep) + (stream . streamp) ++ (string-input-stream . string-input-stream-p) ++ (string-output-stream . string-output-stream-p) + (file-stream . file-stream-p) + (synonym-stream . synonym-stream-p) + (broadcast-stream . broadcast-stream-p) +--- gcl-2.6.12.orig/lsp/gcl_restart.lsp ++++ gcl-2.6.12/lsp/gcl_restart.lsp +@@ -73,7 +73,7 @@ + &aux rr (report (if (stringp report) `(lambda (s) (write-string ,report s)) report))) + (macrolet ((do-setf (x) + `(when ,x +- (setf (getf rr ,(intern (concatenate 'string (symbol-name x) "-FUNCTION") :keyword)) ++ (setf (getf rr ,(intern (string-concatenate (symbol-name x) "-FUNCTION") :keyword)) + (list 'function ,x))))) + (do-setf report) + (do-setf interactive) +--- gcl-2.6.12.orig/lsp/gcl_serror.lsp ++++ gcl-2.6.12/lsp/gcl_serror.lsp +@@ -2,11 +2,11 @@ + (in-package :si) + + (macrolet +- ((make-conditionp (condition &aux (n (intern (concatenate 'string (string condition) "P")))) ++ ((make-conditionp (condition &aux (n (intern (string-concatenate (string condition) "P")))) + `(defun ,n (x &aux (z (si-find-class ',condition))) + (when z + (funcall (setf (symbol-function ',n) (lambda (x) (typep x z))) x)))) +- (make-condition-classp (class &aux (n (intern (concatenate 'string (string class) "-CLASS-P")))) ++ (make-condition-classp (class &aux (n (intern (string-concatenate (string class) "-CLASS-P")))) + `(defun ,n (x &aux (s (si-find-class 'standard-class)) (z (si-find-class ',class))) + (when (and s z) + (funcall (setf (symbol-function ',n) +@@ -124,9 +124,9 @@ + + (defun process-error (datum args &optional (default-type 'simple-error)) + (let ((internal (cond ((simple-condition-class-p datum) +- (find-symbol (concatenate 'string "INTERNAL-" (string datum)) :conditions)) ++ (find-symbol (string-concatenate "INTERNAL-" (string datum)) :conditions)) + ((condition-class-p datum) +- (find-symbol (concatenate 'string "INTERNAL-SIMPLE-" (string datum)) :conditions))))) ++ (find-symbol (string-concatenate "INTERNAL-SIMPLE-" (string datum)) :conditions))))) + (coerce-to-condition (or internal datum) (if internal (list* :function-name *sig-fn-name* args) args) default-type 'process-error))) + + (defun universal-error-handler (n cp fn cs es &rest args &aux (*sig-fn-name* fn)) +--- gcl-2.6.12.orig/lsp/gcl_top.lsp ++++ gcl-2.6.12/lsp/gcl_top.lsp +@@ -593,12 +593,11 @@ First directory is checked for first nam + (when (eq (stat x) :directory) + (return-from get-temp-dir x)))))) + +-(defun get-path (s &aux (m (string-match "([^ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1))) +- (string-concatenate (which (pathname-name (subseq s b e))) (subseq s e))) ++ + + (defvar *cc* "cc") + (defvar *ld* "ld") +-(defvar *objdump* "objdump --source ") ++(defvar *objdump* nil) + + (defvar *current-directory* *system-directory*) + +@@ -608,9 +607,9 @@ First directory is checked for first nam + (declare (fixnum i)) + (setq *current-directory* (current-directory-pathname)) + (setq *tmp-dir* (get-temp-dir) +- *cc* (get-path *cc*) +- *ld* (get-path *ld*) +- *objdump* (get-path *objdump*)) ++ *cc* (or (get-path *cc*) *cc*) ++ *ld* (or (get-path *ld*) *ld*) ++ *objdump* (get-path "objdump --source ")) + (dotimes (j i) (push (argv j) tem)) + (setq *command-args* (nreverse tem)) + (setq tem *lib-directory*) +--- gcl-2.6.12.orig/lsp/gcl_translate_pathname.lsp ++++ gcl-2.6.12/lsp/gcl_translate_pathname.lsp +@@ -32,7 +32,7 @@ + (defun do-repl (x y) + (labels ((r (x l &optional (b 0) &aux (f (string-match #v"\\*" x b))) + (if (eql f -1) (if (eql b 0) x (subseq x b)) +- (concatenate 'string (subseq x b f) (or (car l) "") (r x (cdr l) (1+ f)))))) ++ (string-concatenate (subseq x b f) (or (car l) "") (r x (cdr l) (1+ f)))))) + (r y x))) + + (defun dir-p (x) (when (consp x) (member (car x) '(:absolute :relative)))) +--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp ++++ gcl-2.6.12/lsp/sys-proclaim.lisp +@@ -4,229 +4,269 @@ + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::FIXNUM) +- SYSTEM::ATOI)) ++ COMMON-LISP::*)) ++ COMMON-LISP::T) ++ SYSTEM::RESET-SYS-PATHS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::OR COMMON-LISP::NULL +- COMMON-LISP::HASH-TABLE)) +- SYSTEM::CONTEXT-HASH)) ++ (COMMON-LISP::VECTOR COMMON-LISP::T)) ++ SYSTEM::CONTEXT-VEC)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::T) ++ SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- COMMON-LISP::SUBTYPEP COMMON-LISP::REDUCE +- SLOOP::FIND-IN-ORDERED-LIST SYSTEM::PARSE-BODY +- COMMON-LISP::STABLE-SORT COMMON-LISP::SORT)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ SLOOP::PARSE-LOOP-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ++ SYSTEM::GET-INDEX-NODE SLOOP::LOOP-PEEK ++ ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::STEP-READ-LINE ++ SYSTEM::SET-UP-TOP-LEVEL SLOOP::LOOP-POP SYSTEM::SET-ENV ++ SYSTEM::DBL COMMON-LISP::TYPE-ERROR SYSTEM::INSPECT-INDENT ++ SLOOP::PARSE-LOOP-COLLECT SYSTEM::CLEANUP ++ SYSTEM::DEFAULT-SYSTEM-BANNER ++ SYSTEM::CURRENT-DIRECTORY-PATHNAME ANSI-LOOP::LOOP-DO-WITH ++ SYSTEM::INIT-BREAK-POINTS SYSTEM::TEST-ERROR ++ SYSTEM::GET-SIG-FN-NAME SLOOP::PARSE-ONE-WHEN-CLAUSE ++ ANSI-LOOP::LOOP-DO-DO SYSTEM::READ-EVALUATED-FORM ++ SYSTEM::INSPECT-INDENT-1 ANSI-LOOP::LOOP-DO-NAMED ++ SLOOP::PARSE-LOOP-FOR SYSTEM::ALL-TRACE-DECLARATIONS ++ ANSI-LOOP::LOOP-GET-FORM ANSI-LOOP::LOOP-BIND-BLOCK ++ SLOOP::PARSE-LOOP-WHEN SYSTEM::TOP-LEVEL ++ SYSTEM::DM-TOO-FEW-ARGUMENTS SYSTEM::KCL-TOP-RESTARTS ++ SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::SHOW-RESTARTS ++ SYSTEM::DM-TOO-MANY-ARGUMENTS SYSTEM::SETUP-LINEINFO ++ SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER ++ SLOOP::PARSE-LOOP1 SLOOP::LOOP-UN-POP ++ ANSI-LOOP::LOOP-DO-FINALLY SYSTEM::INSPECT-READ-LINE ++ ANSI-LOOP::LOOP-CONTEXT SYSTEM::SET-CURRENT ++ ANSI-LOOP::LOOP-DO-REPEAT SYSTEM::ILLEGAL-BOA ++ COMMON-LISP::LISP-IMPLEMENTATION-VERSION ++ ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-DO-INITIALLY ++ ANSI-LOOP::LOOP-GET-PROGN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::SHARP-+-READER SYSTEM::SHARP---READER +- SYSTEM::SHARP-S-READER ANSI-LOOP::LOOP-GET-COLLECTION-INFO +- SYSTEM::VERIFY-KEYWORDS SYSTEM::LIST-MERGE-SORT +- SYSTEM::RESTART-PRINT SYSTEM::READ-INSPECT-COMMAND)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ COMMON-LISP::HASH-TABLE) ++ SYSTEM::CONTEXT-SPICE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::TRACE-CALL)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::OR COMMON-LISP::NULL ++ COMMON-LISP::HASH-TABLE)) ++ SYSTEM::CONTEXT-HASH)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::*) +- SYSTEM::EXPAND-WILD-DIRECTORY SYSTEM::MASET)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::RELATIVE-LINE ++ SYSTEM::LENEL SYSTEM::GET-NODE-INDEX SYSTEM::FASLINK ++ SYSTEM::THE-END)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::MME3)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::DESETQ1 ++ COMMON-LISP::LOGANDC2 ANSI-LOOP::MAKE-LOOP-MINIMAX ++ COMMON-LISP::WRITE-BYTE SYSTEM::MATCH-DIMENSIONS ++ SLOOP::IN-CAREFULLY-SLOOP-FOR SLOOP::SUM-SLOOP-COLLECT ++ SYSTEM::DOT-DIR-P SLOOP::IN-FRINGE-SLOOP-MAP ++ SLOOP::COLLATE-SLOOP-COLLECT ANSI-LOOP::LOOP-TMEMBER ++ FPE::READ-OPERANDS SYSTEM::IN-INTERVAL-P SYSTEM::SUBSTRINGP ++ FPE::PAREN-READER ANSI-LOOP::HIDE-VARIABLE-REFERENCES ++ SYSTEM::QUOTATION-READER SYSTEM::ALL-MATCHES SYSTEM::GET-MATCH ++ SYSTEM::ADD-FILE ANSI-LOOP::LOOP-DO-ALWAYS SLOOP::THE-TYPE ++ SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR ++ SYSTEM::CHECK-SEQ-START-END SLOOP::MAKE-VALUE ++ SLOOP::THEREIS-SLOOP-COLLECT ANSI-LOOP::LOOP-DO-WHILE ++ COMMON-LISP::COERCE ANSI-LOOP::LOOP-TEQUAL ++ ANSI-LOOP::LOOP-DECLARE-VARIABLE COMMON-LISP::LOGNAND ++ COMMON-LISP::LOGORC1 SYSTEM::BREAK-STEP-NEXT ++ SLOOP::LOGXOR-SLOOP-COLLECT COMMON-LISP::LOGNOR ++ COMPILER::COMPILER-DEF-HOOK ANSI-LOOP::LOOP-TASSOC ++ SYSTEM::GET-LINE-OF-FORM SLOOP::MAXIMIZE-SLOOP-COLLECT ++ ANSI-LOOP::LOOP-DO-IF SYSTEM::SETF-EXPAND SYSTEM::DM-V ++ SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::NTHCDR ++ SYSTEM::CONDITION-PASS SYSTEM::DISPLAY-COMPILED-ENV ++ COMMON-LISP::LDB-TEST ANSI-LOOP::LOOP-MAYBE-BIND-FORM ++ SYSTEM::SUPER-GO SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS ++ FPE::RF SYSTEM::SUB-INTERVAL-P SYSTEM::LEFT-PARENTHESIS-READER ++ COMMON-LISP::FILE-STRING-LENGTH SYSTEM::OBJLT SYSTEM::MSUB ++ SYSTEM::COERCE-TO-STRING SYSTEM::SAFE-EVAL ++ SYSTEM::SET-PATH-STREAM-NAME SYSTEM::SET-BACK ++ ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION COMMON-LISP::LOGTEST ++ SYSTEM::*BREAK-POINTS* SLOOP::=-SLOOP-FOR ++ SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::KEYWORD-SUPPLIED-P ++ SLOOP::COUNT-SLOOP-COLLECT FPE::%-READER COMMON-LISP::LOGORC2 ++ SYSTEM::SEQUENCE-CURSOR SYSTEM::LOOKUP-KEYWORD ++ COMMON-LISP::BYTE SYSTEM::PARSE-SLOT-DESCRIPTION ++ COMMON-LISP::LOGANDC1 SYSTEM::DM-NTH-CDR FPE::0-READER ++ SLOOP::L-EQUAL SYSTEM::LIST-DELQ SYSTEM::DM-NTH ++ COMMON-LISP::LDB SYSTEM::SETF-HELPER ++ SLOOP::NEVER-SLOOP-COLLECT SLOOP::PARSE-LOOP-MAP ++ COMMON-LISP::NTH SYSTEM::BREAK-STEP-INTO ++ SYSTEM::GET-INFO-CHOICES SLOOP::IN-TABLE-SLOOP-MAP ++ SYSTEM::GET-NODES COMMON-LISP::VECTOR-PUSH ++ COMMON-LISP::PATHNAME-MATCH-P SYSTEM::DBL-UP ++ ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::READ-INSTRUCTION ++ SLOOP::ALWAYS-SLOOP-COLLECT SYSTEM::SET-DIR SYSTEM::INFO-AUX ++ SYSTEM::DISPLAY-ENV COMMON-LISP::DOCUMENTATION ++ SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) +- SYSTEM::PUSH-OPTIONAL-BINDING)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +- SYSTEM::MAKE-KEYWORD)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- SYSTEM::QUICK-SORT)) ++ COMMON-LISP::APROPOS ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE ++ COMMON-LISP::FFLOOR SYSTEM::PRINT-DOC SYSTEM::INFO ++ SYSTEM::PARSE-BODY-HEADER COMMON-LISP::INVOKE-RESTART ++ SYSTEM::BREAK-FUNCTION SYSTEM::SHOW-INFO COMMON-LISP::FROUND ++ COMMON-LISP::GET-SETF-EXPANSION COMMON-LISP::PARSE-NAMESTRING ++ SYSTEM::APROPOS-DOC COMMON-LISP::ENSURE-DIRECTORIES-EXIST ++ COMMON-LISP::USE-VALUE COMMON-LISP::READ-FROM-STRING ++ COMMON-LISP::FTRUNCATE COMMON-LISP::STORE-VALUE ++ SYSTEM::STEPPER SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE ++ COMMON-LISP::APROPOS-LIST COMMON-LISP::FCEILING ++ COMMON-LISP::WRITE-TO-STRING ++ COMMON-LISP::DECODE-UNIVERSAL-TIME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::BIGNTHCDR)) ++ SYSTEM::SETF-EXPAND-1 SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS ++ SYSTEM::WARN-VERSION ANSI-LOOP::LOOP-TRANSLATE ++ ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::PRINT-LOOP-UNIVERSE ++ ANSI-LOOP::LOOP-STANDARD-EXPANSION ++ ANSI-LOOP::LOOP-ANSI-FOR-EQUALS SYSTEM::DM-VL ++ SYSTEM::SHARP-A-READER COMMON-LISP::DEPOSIT-FIELD ++ SYSTEM::RESTART-CASE-EXPRESSION-CONDITION ++ SYSTEM::APPLY-DISPLAY-FUN ANSI-LOOP::HIDE-VARIABLE-REFERENCE ++ SYSTEM::FLOATING-POINT-ERROR SYSTEM::GET-SLOT-POS ++ ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ++ SYSTEM::MAKE-BREAK-POINT SYSTEM::SHARP-V-READER ++ SYSTEM::TO-REGEXP-OR-NAMESTRING ANSI-LOOP::LOOP-FOR-ON ++ SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-SUM-COLLECTION ++ SYSTEM::SHARP-P-READER SYSTEM::MAKE-T-TYPE ++ ANSI-LOOP::LOOP-FOR-ACROSS SYSTEM::MFR SYSTEM::RECURSE-DIR ++ SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-FOR-BEING ++ COMMON-LISP::DPB SYSTEM::SHARP-DQ-READER ++ SYSTEM::CHECK-TRACE-ARGS SYSTEM::DEFMACRO* ++ SYSTEM::CHECK-S-DATA FPE::REF)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- COMMON-LISP::EVERY COMMON-LISP::SET-DIFFERENCE +- SYSTEM::VECTOR-PUSH-STRING SYSTEM::PROCESS-ERROR +- COMMON-LISP::POSITION-IF-NOT COMMON-LISP::FIND-IF +- SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ORC1 +- COMMON-LISP::READ-SEQUENCE SYSTEM::INTERNAL-COUNT-IF +- COMMON-LISP::COUNT COMMON-LISP::MISMATCH +- COMMON-LISP::ADJUST-ARRAY COMMON-LISP::INTERSECTION +- COMMON-LISP::UNION COMMON-LISP::DELETE-IF-NOT +- COMMON-LISP::NINTERSECTION COMMON-LISP::BIT-ANDC1 +- COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::TYPEP +- COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE +- COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::REMOVE +- COMMON-LISP::BIT-IOR SLOOP::PARSE-LOOP-MACRO +- COMMON-LISP::SEARCH COMMON-LISP::SUBSETP +- COMMON-LISP::SET-EXCLUSIVE-OR SYSTEM::WREADDIR +- COMMON-LISP::POSITION-IF COMMON-LISP::DELETE +- COMMON-LISP::BIT-EQV COMMON-LISP::BIT-ANDC2 +- COMMON-LISP::BIT-AND COMMON-LISP::NSET-EXCLUSIVE-OR +- SLOOP::IN-ARRAY-SLOOP-FOR ANSI-LOOP::LOOP-CHECK-DATA-TYPE +- COMMON-LISP::POSITION COMMON-LISP::MAKE-SEQUENCE +- COMMON-LISP::NOTEVERY COMMON-LISP::MAP-INTO +- COMMON-LISP::REPLACE COMMON-LISP::NSET-DIFFERENCE ++ SYSTEM::FIND-IHS COMMON-LISP::NSET-DIFFERENCE ++ COMMON-LISP::BIT-NAND SYSTEM::BREAK-CALL ++ COMMON-LISP::COUNT-IF-NOT COMMON-LISP::DELETE ++ SYSTEM::INTERNAL-COUNT COMMON-LISP::BIT-ORC1 ++ COMMON-LISP::DELETE-IF COMMON-LISP::BIT-ANDC1 ++ SYSTEM::VECTOR-PUSH-STRING COMMON-LISP::MISMATCH ++ COMMON-LISP::NOTEVERY SYSTEM::PROCESS-ERROR COMMON-LISP::TYPEP ++ COMMON-LISP::BIT-IOR COMMON-LISP::BIT-EQV ++ COMMON-LISP::COUNT-IF COMMON-LISP::REMOVE-IF ++ COMMON-LISP::EVERY COMMON-LISP::POSITION-IF-NOT ++ COMMON-LISP::ADJUST-ARRAY COMMON-LISP::VECTOR-PUSH-EXTEND ++ SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::COUNT ++ COMMON-LISP::DELETE-IF-NOT COMMON-LISP::NINTERSECTION + COMMON-LISP::FIND-IF-NOT COMMON-LISP::BIT-ORC2 +- COMMON-LISP::DELETE-IF COMMON-LISP::CERROR +- COMMON-LISP::BIT-XOR COMMON-LISP::FIND COMMON-LISP::FILL +- SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::REMOVE-IF +- COMMON-LISP::BIT-NAND COMMON-LISP::BIT-NOR COMMON-LISP::SOME +- COMMON-LISP::COUNT-IF SYSTEM::BREAK-CALL +- COMMON-LISP::COUNT-IF-NOT SYSTEM::FIND-IHS COMMON-LISP::NOTANY +- SYSTEM::INTERNAL-COUNT)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- SYSTEM::PATHNAME-PARSE ANSI-LOOP::LOOP-TRANSLATE +- SYSTEM::CHECK-S-DATA SYSTEM::MFR FPE::REF +- ANSI-LOOP::LOOP-STANDARD-EXPANSION ANSI-LOOP::LOOP-FOR-ON +- ANSI-LOOP::LOOP-SUM-COLLECTION SYSTEM::SHARP-DQ-READER +- COMMON-LISP::DPB SYSTEM::CHECK-TRACE-ARGS +- SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS SYSTEM::RECURSE-DIR +- SYSTEM::SHARP-U-READER SYSTEM::FLOATING-POINT-ERROR +- ANSI-LOOP::LOOP-FOR-IN ANSI-LOOP::HIDE-VARIABLE-REFERENCE +- SYSTEM::GET-SLOT-POS SYSTEM::APPLY-DISPLAY-FUN +- SYSTEM::RESTART-CASE-EXPRESSION-CONDITION +- SYSTEM::MAKE-BREAK-POINT SYSTEM::TO-REGEXP-OR-NAMESTRING +- COMMON-LISP::DEPOSIT-FIELD SYSTEM::SHARP-V-READER +- SYSTEM::MAKE-T-TYPE ANSI-LOOP::LOOP-FOR-ACROSS +- ANSI-LOOP::LOOP-ANSI-FOR-EQUALS ANSI-LOOP::PRINT-LOOP-UNIVERSE +- ANSI-LOOP::LOOP-FOR-BEING SYSTEM::SHARP-P-READER SYSTEM::DM-VL +- SYSTEM::SHARP-A-READER ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE +- SYSTEM::DEFMACRO* SYSTEM::SETF-EXPAND-1 SYSTEM::WARN-VERSION)) ++ COMMON-LISP::SUBSETP COMMON-LISP::SOME SYSTEM::WREADDIR ++ COMMON-LISP::SET-DIFFERENCE COMMON-LISP::UNION ++ COMMON-LISP::BIT-XOR SLOOP::PARSE-LOOP-MACRO ++ COMMON-LISP::REPLACE COMMON-LISP::REMOVE ++ SLOOP::LOOP-ADD-BINDING COMMON-LISP::BIT-ANDC2 ++ COMMON-LISP::READ-SEQUENCE COMMON-LISP::CERROR ++ COMMON-LISP::INTERSECTION COMMON-LISP::POSITION-IF ++ ANSI-LOOP::LOOP-CHECK-DATA-TYPE SYSTEM::INTERNAL-COUNT-IF ++ COMMON-LISP::NUNION COMMON-LISP::WRITE-SEQUENCE ++ COMMON-LISP::MAP-INTO COMMON-LISP::MAKE-SEQUENCE ++ COMMON-LISP::SET-EXCLUSIVE-OR SLOOP::IN-ARRAY-SLOOP-FOR ++ COMMON-LISP::FIND-IF COMMON-LISP::SEARCH COMMON-LISP::FILL ++ COMMON-LISP::FIND COMMON-LISP::NOTANY ++ COMMON-LISP::NSET-EXCLUSIVE-OR COMMON-LISP::BIT-NOR ++ COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::POSITION ++ COMMON-LISP::BIT-AND)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::MME2 COMMON-LISP::NSUBSTITUTE SYSTEM::MATCH-COMPONENT +- SYSTEM::COMPLETE-PROP SYSTEM::WALK-DIR +- COMMON-LISP::TRANSLATE-PATHNAME ANSI-LOOP::ADD-LOOP-PATH +- SYSTEM::DIR-PARSE ANSI-LOOP::LOOP-MAKE-VARIABLE +- COMMON-LISP::SUBSTITUTE-IF COMMON-LISP::NSUBSTITUTE-IF +- SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE +- ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH COMMON-LISP::MAP +- COMMON-LISP::SUBSTITUTE-IF-NOT COMMON-LISP::NSUBSTITUTE-IF-NOT +- ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH +- SLOOP::LOOP-DECLARE-BINDING +- ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH +- SYSTEM::CHECK-TYPE-SYMBOL)) ++ SYSTEM::FIND-LINE-IN-FUN ANSI-LOOP::LOOP-FOR-ARITHMETIC ++ SYSTEM::EXPAND-RANGE SYSTEM::MAYBE-BREAK SYSTEM::MINMAX ++ SLOOP::FIRST-USE-SLOOP-FOR SLOOP::FIRST-SLOOP-FOR ++ SYSTEM::SETF-STRUCTURE-ACCESS SYSTEM::DO-BREAK-LEVEL ++ SYSTEM::CALL-TEST SYSTEM::ELEMENT SYSTEM::LOAD-PATHNAME ++ SYSTEM::COERCE-TO-CONDITION SYSTEM::ELSUB)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T +- (COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- SYSTEM::SHARP-EQ-READER SYSTEM::SHARP-SHARP-READER)) ++ SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE ++ SYSTEM::PRINT-STACK-FRAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) + COMMON-LISP::T) +- SYSTEM::ELSUB SLOOP::FIRST-USE-SLOOP-FOR +- SLOOP::FIRST-SLOOP-FOR SYSTEM::SETF-STRUCTURE-ACCESS +- SYSTEM::FIND-LINE-IN-FUN SYSTEM::COERCE-TO-CONDITION +- ANSI-LOOP::LOOP-FOR-ARITHMETIC SYSTEM::MAYBE-BREAK +- SYSTEM::ELEMENT SYSTEM::DO-BREAK-LEVEL SYSTEM::CALL-TEST)) ++ COMMON-LISP::ENCODE-UNIVERSAL-TIME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) ++ COMMON-LISP::*) + COMMON-LISP::T) +- ANSI-LOOP::LOOP-SEQUENCER)) ++ ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH ++ SYSTEM::COMPLETE-PROP SYSTEM::CHECK-TYPE-SYMBOL ++ COMMON-LISP::NSUBSTITUTE ++ ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH COMMON-LISP::SUBSTITUTE ++ COMMON-LISP::TRANSLATE-PATHNAME COMMON-LISP::NSUBSTITUTE-IF ++ COMMON-LISP::MAP SLOOP::LOOP-DECLARE-BINDING SYSTEM::WALK-DIR ++ SYSTEM::MATCH-COMPONENT ANSI-LOOP::LOOP-MAKE-VARIABLE ++ ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::SUBSTITUTE-IF ++ COMMON-LISP::NSUBSTITUTE-IF-NOT SYSTEM::MME2 ++ ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH ++ COMMON-LISP::SUBSTITUTE-IF-NOT SYSTEM::PUSH-LET-BINDING)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::T COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) ++ SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) ++ SYSTEM::DO-ARG-COUNT-ERROR SYSTEM::PUSH-SUB-LIST-BINDING)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SLOOP::DEF-LOOP-INTERNAL COMMON-LISP::MERGE +- SYSTEM::PRINT-STACK-FRAME)) ++ SYSTEM::MAKE-CONSTRUCTOR SYSTEM::MAKE-PREDICATE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) + COMMON-LISP::T) +- COMMON-LISP::ENCODE-UNIVERSAL-TIME)) ++ ANSI-LOOP::LOOP-SEQUENCER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -234,43 +274,50 @@ + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) + SYSTEM::UNIVERSAL-ERROR-HANDLER)) ++(COMMON-LISP::MAPC ++ (COMMON-LISP::LAMBDA (COMPILER::X) ++ (COMMON-LISP::SETF ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) ++ COMMON-LISP::T)) ++ '(SYSTEM::SI-FIND-CLASS SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF ++ SYSTEM::CONDITION-CLASS-P SYSTEM::UNTRACE-ONE ++ SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SIMPLE-CONDITION-CLASS-P ++ SYSTEM::CONDITIONP SYSTEM::AUTOLOAD ++ SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP ++ FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::TRACE-ONE ++ SYSTEM::AUTOLOAD-MACRO SYSTEM::DEFINE-STRUCTURE ++ SYSTEM::SI-CLASS-NAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- COMMON-LISP::MERGE-PATHNAMES +- COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME ANSI-LOOP::LOOP-ERROR +- COMMON-LISP::WILD-PATHNAME-P SLOOP::LOOP-ADD-TEMPS +- SYSTEM::FILE-SEARCH SYSTEM::INFO-SEARCH +- COMMON-LISP::PATHNAME-VERSION COMMON-LISP::WARN SYSTEM::MGSUB +- COMMON-LISP::ARRAY-ROW-MAJOR-INDEX +- COMMON-LISP::REMOVE-DUPLICATES COMMON-LISP::PATHNAME-NAME +- COMMON-LISP::BIT COMMON-LISP::FIND-RESTART SYSTEM::TO-REGEXP +- SYSTEM::PROCESS-SOME-ARGS COMMON-LISP::ERROR +- COMMON-LISP::REQUIRE COMMON-LISP::OPEN +- COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE SLOOP::ADD-FROM-DATA +- SYSTEM::BREAK-LEVEL SYSTEM::LIST-MATCHES +- COMMON-LISP::DELETE-DUPLICATES ANSI-LOOP::LOOP-WARN +- COMMON-LISP::PATHNAME-DEVICE COMMON-LISP::LOAD +- COMMON-LISP::PATHNAME-HOST COMMON-LISP::SBIT SYSTEM::NLOAD +- COMMON-LISP::BIT-NOT COMMON-LISP::ENOUGH-NAMESTRING +- COMMON-LISP::SIGNAL COMMON-LISP::ARRAY-IN-BOUNDS-P +- COMMON-LISP::PATHNAME-TYPE SYSTEM::FILE-TO-STRING +- SYSTEM::LOGICAL-PATHNAME-PARSE SYSTEM::NTH-STACK-FRAME +- ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES SYSTEM::MGLIST +- COMMON-LISP::DIRECTORY SYSTEM::BAD-SEQ-LIMIT +- COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::READ-BYTE +- SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE +- COMMON-LISP::MAKE-ARRAY)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ SYSTEM::INSTREAM-NAME ANSI-LOOP::LOOP-LIST-STEP ++ COMMON-LISP::PRIN1-TO-STRING ANSI-LOOP::NAMED-VARIABLE ++ SYSTEM::WAITING SYSTEM::FIND-DECLARATIONS COMMON-LISP::INSPECT ++ SYSTEM::END-WAITING SYSTEM::BREAK-GO SYSTEM::INFO-SUBFILE ++ COMMON-LISP::INVOKE-RESTART-INTERACTIVELY ++ ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::INSPECT-OBJECT ++ SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::EXPAND-RANGES ++ SYSTEM::GET-&ENVIRONMENT COMMON-LISP::DESCRIBE ++ COMMON-LISP::PRINC-TO-STRING)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- SYSTEM::NEWLINE SYSTEM::LIST-TOGGLE-CASE +- COMMON-LISP::RENAME-FILE ANSI-LOOP::ESTIMATE-CODE-SIZE +- SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT SYSTEM::DO-REPL +- SYSTEM::FIND-DOC ANSI-LOOP::ESTIMATE-CODE-SIZE-1 +- SYSTEM::NEW-SEMI-COLON-READER)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE ++ SYSTEM::MAKE-S-DATA ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL ++ ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::CURRENT-STEP-FUN SYSTEM::LOC ++ SYSTEM::DBL-READ SYSTEM::MAKE-RESTART ++ SYSTEM::TRANSFORM-KEYWORDS COMMON-LISP::Y-OR-N-P ++ SYSTEM::NEXT-MATCH COMMON-LISP::COMPUTE-RESTARTS ++ SLOOP::PARSE-LOOP-WITH COMMON-LISP::VECTOR SYSTEM::STEP-NEXT ++ ANSI-LOOP::MAKE-LOOP-COLLECTOR ++ COMMON-LISP::USER-HOMEDIR-PATHNAME SLOOP::PARSE-LOOP-DECLARE ++ COMMON-LISP::YES-OR-NO-P SYSTEM::STEP-INTO ++ SYSTEM::MAKE-CONTEXT SYSTEM::BREAK-LOCALS ++ SYSTEM::DESCRIBE-ENVIRONMENT COMMON-LISP::DRIBBLE ++ ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL SYSTEM::MAYBE-CLEAR-INPUT ++ COMMON-LISP::BREAK ANSI-LOOP::LOOP-GENTEMP ++ ANSI-LOOP::MAKE-LOOP-UNIVERSE SYSTEM::MAKE-INSTREAM ++ COMMON-LISP::MAKE-PATHNAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -280,74 +327,6 @@ + FPE::FE-ENABLE SYSTEM::DBL-WHAT-FRAME)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- SYSTEM::INFO SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE +- COMMON-LISP::FTRUNCATE COMMON-LISP::USE-VALUE +- COMMON-LISP::INVOKE-RESTART COMMON-LISP::WRITE-TO-STRING +- COMMON-LISP::FCEILING COMMON-LISP::FROUND +- COMMON-LISP::READ-FROM-STRING COMMON-LISP::FFLOOR +- SYSTEM::PARSE-BODY-HEADER SYSTEM::BREAK-FUNCTION +- SYSTEM::APROPOS-DOC COMMON-LISP::APROPOS +- COMMON-LISP::APROPOS-LIST +- ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE +- COMMON-LISP::GET-SETF-EXPANSION SYSTEM::PRINT-DOC +- COMMON-LISP::PARSE-NAMESTRING +- COMMON-LISP::ENSURE-DIRECTORIES-EXIST +- COMMON-LISP::DECODE-UNIVERSAL-TIME SYSTEM::SHOW-INFO +- COMMON-LISP::STORE-VALUE SYSTEM::STEPPER)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::T) +- COMMON-LISP::VECTOR-PUSH SYSTEM::DM-NTH COMMON-LISP::LOGORC1 +- SLOOP::L-EQUAL SLOOP::NEVER-SLOOP-COLLECT +- COMMON-LISP::LDB-TEST COMMON-LISP::LDB COMMON-LISP::LOGORC2 +- SLOOP::COUNT-SLOOP-COLLECT SLOOP::MAXIMIZE-SLOOP-COLLECT +- SYSTEM::ALL-MATCHES ANSI-LOOP::LOOP-TMEMBER SLOOP::THE-TYPE +- SYSTEM::?PUSH SYSTEM::INCREMENT-CURSOR SYSTEM::SET-DIR +- SYSTEM::DM-NTH-CDR SYSTEM::IN-INTERVAL-P SLOOP::MAKE-VALUE +- SYSTEM::DBL-UP COMMON-LISP::COERCE SYSTEM::MATCH-DIMENSIONS +- COMMON-LISP::LOGNAND SLOOP::=-SLOOP-FOR +- SYSTEM::KEYWORD-SUPPLIED-P SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS +- SYSTEM::LEFT-PARENTHESIS-READER +- ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::COERCE-TO-STRING +- SYSTEM::ADD-FILE SLOOP::PARSE-LOOP-MAP COMMON-LISP::LOGNOR +- SYSTEM::MSUB SYSTEM::SET-BACK SYSTEM::SUPER-GO +- SYSTEM::SUBSTRINGP ANSI-LOOP::LOOP-TEQUAL +- ANSI-LOOP::LOOP-DO-WHILE SYSTEM::GET-LINE-OF-FORM +- FPE::READ-INSTRUCTION SYSTEM::SUB-INTERVAL-P +- SYSTEM::CHECK-SEQ-START-END SYSTEM::*BREAK-POINTS* +- ANSI-LOOP::MAKE-LOOP-MINIMAX SLOOP::IN-PACKAGE-SLOOP-MAP +- SYSTEM::DM-V SYSTEM::INFO-AUX +- ANSI-LOOP::HIDE-VARIABLE-REFERENCES +- SLOOP::COLLATE-SLOOP-COLLECT COMMON-LISP::PATHNAME-MATCH-P +- SYSTEM::SET-PATH-STREAM-NAME SLOOP::SUM-SLOOP-COLLECT +- ANSI-LOOP::LOOP-LOOKUP-KEYWORD +- ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::BREAK-STEP-NEXT +- FPE::RF SLOOP::IN-TABLE-SLOOP-MAP SYSTEM::OBJLT +- FPE::READ-OPERANDS SYSTEM::BREAK-STEP-INTO COMMON-LISP::BYTE +- SYSTEM::SEQUENCE-CURSOR SYSTEM::LIST-DELQ +- SYSTEM::SETF-LOGICAL-PATHNAME-TRANSLATIONS +- SYSTEM::CONDITION-PASS SYSTEM::SETF-HELPER FPE::0-READER +- SYSTEM::DISPLAY-COMPILED-ENV COMMON-LISP::NTH +- COMPILER::COMPILER-DEF-HOOK SYSTEM::DOT-DIR-P +- COMMON-LISP::LOGTEST SYSTEM::QUOTATION-READER +- SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGANDC1 +- SLOOP::ALWAYS-SLOOP-COLLECT SLOOP::DESETQ1 +- SYSTEM::GET-INFO-CHOICES COMMON-LISP::WRITE-BYTE +- ANSI-LOOP::LOOP-DO-IF ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION +- ANSI-LOOP::LOOP-TASSOC SLOOP::IN-CAREFULLY-SLOOP-FOR +- COMMON-LISP::DOCUMENTATION FPE::PAREN-READER SYSTEM::GET-NODES +- SYSTEM::PARSE-SLOT-DESCRIPTION SLOOP::IN-FRINGE-SLOOP-MAP +- SYSTEM::SAFE-EVAL SYSTEM::DISPLAY-ENV FPE::%-READER +- SLOOP::THEREIS-SLOOP-COLLECT SYSTEM::LOOKUP-KEYWORD +- COMMON-LISP::LOGANDC2 COMMON-LISP::NTHCDR +- SLOOP::MINIMIZE-SLOOP-COLLECT SYSTEM::GET-MATCH +- SYSTEM::SETF-EXPAND SLOOP::LOGXOR-SLOOP-COLLECT +- ANSI-LOOP::LOOP-DO-ALWAYS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + ((COMMON-LISP::INTEGER -9223372036854775808 + 9223372036854775807) +@@ -357,263 +336,300 @@ + SYSTEM::ROUND-UP)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- COMMON-LISP::Y-OR-N-P COMMON-LISP::YES-OR-NO-P +- COMMON-LISP::DRIBBLE COMMON-LISP::VECTOR SYSTEM::NEXT-MATCH +- SYSTEM::MAKE-S-DATA SYSTEM::LOC SYSTEM::BREAK-LOCALS +- SLOOP::PARSE-LOOP-WITH COMMON-LISP::USER-HOMEDIR-PATHNAME +- SYSTEM::STEP-INTO SYSTEM::MAYBE-CLEAR-INPUT +- ANSI-LOOP::MAKE-LOOP-PATH SYSTEM::STEP-NEXT +- ANSI-LOOP::LOOP-GENTEMP COMMON-LISP::COMPUTE-RESTARTS +- SYSTEM::CURRENT-STEP-FUN SYSTEM::MAKE-INSTREAM +- ANSI-LOOP::MAKE-LOOP-COLLECTOR SYSTEM::MAKE-RESTART +- SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::TRANSFORM-KEYWORDS +- COMMON-LISP::ABORT ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE +- ANSI-LOOP::MAKE-LOOP-UNIVERSE SLOOP::PARSE-LOOP-DECLARE +- COMMON-LISP::BREAK ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL +- SYSTEM::MAKE-CONTEXT SYSTEM::DBL-READ +- COMMON-LISP::MAKE-PATHNAME +- ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES SYSTEM::BREAK-GO +- COMMON-LISP::FILE-AUTHOR SYSTEM::ENSURE-DIR-STRING +- SYSTEM::INFO-SUBFILE COMMON-LISP::DESCRIBE SYSTEM::END-WAITING +- COMMON-LISP::PRIN1-TO-STRING SYSTEM::FIND-DECLARATIONS +- COMMON-LISP::INSPECT ANSI-LOOP::NAMED-VARIABLE +- SYSTEM::GET-&ENVIRONMENT SYSTEM::INSPECT-OBJECT +- COMMON-LISP::PRINC-TO-STRING ANSI-LOOP::LOOP-LIST-STEP +- SYSTEM::INSTREAM-NAME SYSTEM::BREAK-LEVEL-INVOKE-RESTART +- SYSTEM::WAITING COMMON-LISP::INVOKE-RESTART-INTERACTIVELY)) ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) ++ COMMON-LISP::FIXNUM) ++ SYSTEM::ATOI)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- SYSTEM::IHS-NOT-INTERPRETED-ENV COMMON-LISP::NINTH +- SYSTEM::FIND-KCL-TOP-RESTART COMMON-LISP::TRUENAME +- SYSTEM::DIRECTORY-LIST-CHECK SYSTEM::REAL-ASINH +- SYSTEM::SHOW-ENVIRONMENT SYSTEM::PRINT-FRS +- SYSTEM::REWRITE-RESTART-CASE-CLAUSE +- COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM +- ANSI-LOOP::LOOP-COLLECTOR-DATA SLOOP::POINTER-FOR-COLLECT +- SYSTEM::MLP SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::LNP +- ANSI-LOOP::LOOP-MINIMAX-OPERATIONS SYSTEM::FRS-KIND +- SYSTEM::BKPT-FILE COMMON-LISP::FIFTH +- ANSI-LOOP::LOOP-COLLECTOR-P ANSI-LOOP::LOOP-UNIVERSE-ANSI +- ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::IDESCRIBE +- ANSI-LOOP::LOOP-CONSTANTP +- ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS COMMON-LISP::PROBE-FILE +- ANSI-LOOP::LOOP-UNIVERSE-P COMMON-LISP::SINH SYSTEM::RESTART-P +- SYSTEM::S-DATA-DOCUMENTATION ++ SYSTEM::REGEXP-CONV SYSTEM::DIR-CONJ SYSTEM::DIR-P ++ ANSI-LOOP::LOOP-LIST-COLLECTION COMMON-LISP::COSH ++ SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::INSPECT-CONS ++ SYSTEM::KNOWN-TYPE-P SYSTEM::LNP COMMON-LISP::SEVENTH ++ SYSTEM::BKPT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P ++ COMMON-LISP::COMPILER-MACRO-FUNCTION ++ ANSI-LOOP::LOOP-HACK-ITERATION + COMMON-LISP::ECHO-STREAM-OUTPUT-STREAM +- SYSTEM::FIND-DOCUMENTATION SYSTEM::INFO-GET-FILE +- SLOOP::PARSE-NO-BODY COMMON-LISP::FILE-NAMESTRING +- COMMON-LISP::COMPILER-MACRO-FUNCTION SYSTEM::PROCESS-ARGS +- ANSI-LOOP::LOOP-COLLECTOR-DTYPE COMMON-LISP::PHASE +- SYSTEM::MAKE-FRAME SYSTEM::INSTREAM-STREAM +- ANSI-LOOP::LOOP-COLLECTOR-HISTORY SYSTEM::FIX-LOAD-PATH +- SYSTEM::COMPUTING-ARGS-P +- ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE COMMON-LISP::TENTH +- ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::WILD-NAMESTRING-P +- SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::DM-BAD-KEY +- SYSTEM::TERMINAL-INTERRUPT SYSTEM::REGEXP-CONV +- COMMON-LISP::FILE-WRITE-DATE SLOOP::PARSE-LOOP +- ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::DWIM ++ SYSTEM::DIRECTORY-LIST-CHECK COMMON-LISP::FILE-WRITE-DATE ++ SYSTEM::NORMALIZE-TYPE COMMON-LISP::EIGHTH SYSTEM::TOGGLE-CASE ++ SYSTEM::SHOW-ENVIRONMENT ++ COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM SYSTEM::GET-PATH ++ COMMON-LISP::ASINH SYSTEM::FIND-KCL-TOP-RESTART ++ SYSTEM::RESTART-P SYSTEM::EVAL-FEATURE SYSTEM::ALOAD ++ COMMON-LISP::PHASE SLOOP::SUBSTITUTE-SLOOP-BODY ++ COMMON-LISP::ASIN SYSTEM::NODES-FROM-INDEX ++ SYSTEM::MAKE-DEFPACKAGE-FORM ANSI-LOOP::LOOP-COLLECTOR-DTYPE ++ SYSTEM::LOGICAL-PATHNAMEP SYSTEM::INSPECT-VECTOR + ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS +- SLOOP::RETURN-SLOOP-MACRO SLOOP::AVERAGING-SLOOP-MACRO +- SYSTEM::S-DATA-NAME SYSTEM::CHECK-TRACE-SPEC +- SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::TRANSLATE-NAME +- SYSTEM::ADD-TO-HOTLIST SYSTEM::S-DATA-CONC-NAME +- ANSI-LOOP::LOOP-MINIMAX-TYPE SYSTEM::PRINT-IHS +- SYSTEM::DBL-RPL-LOOP SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY +- SYSTEM::INSPECT-CONS SYSTEM::INSTREAM-STREAM-NAME +- SYSTEM::S-DATA-P SYSTEM::EVAL-FEATURE +- COMMON-LISP::ARRAY-DIMENSIONS SYSTEM::IHS-VISIBLE +- ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE +- SYSTEM::CHECK-DECLARATIONS COMMON-LISP::TANH +- ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS +- COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::INSPECT-PACKAGE +- SLOOP::LOOP-LET-BINDINGS COMMON-LISP::CIS SYSTEM::SETUP-INFO +- SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-PSEUDO-BODY +- SYSTEM::PATH-STREAM-NAME SYSTEM::INFO-GET-TAGS FPE::ST-LOOKUP +- SYSTEM::BREAK-BACKWARD-SEARCH-STACK +- ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SIMPLE-ARRAY-P +- SYSTEM::S-DATA-TYPE COMMON-LISP::CONCATENATED-STREAM-STREAMS +- SYSTEM::INSPECT-CHARACTER ANSI-LOOP::DESTRUCTURING-SIZE +- SYSTEM::GET-BYTE-STREAM-NCHARS ANSI-LOOP::LOOP-PATH-P +- COMMON-LISP::FIRST COMMON-LISP::SECOND +- COMMON-LISP::TWO-WAY-STREAM-INPUT-STREAM +- SYSTEM::MAKE-DEFPACKAGE-FORM SYSTEM::INSPECT-SYMBOL +- SYSTEM::INSPECT-VECTOR +- COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS +- SYSTEM::RESTART-INTERACTIVE-FUNCTION SYSTEM::INSPECT-STRING +- SYSTEM::DIR-P ANSI-LOOP::LOOP-COLLECTOR-CLASS +- SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::NODES-FROM-INDEX +- SYSTEM::VERSION-PARSE SYSTEM::BKPT-FILE-LINE COMMON-LISP::ABS +- SYSTEM::IHS-FNAME ANSI-LOOP::LOOP-MAKE-PSETQ +- SYSTEM::LEAP-YEAR-P ANSI-LOOP::LOOP-EMIT-FINAL-VALUE +- SYSTEM::GET-PATH SYSTEM::ALOAD SYSTEM::DM-KEY-NOT-ALLOWED +- SYSTEM::MAKE-KCL-TOP-RESTART SYSTEM::S-DATA-SLOT-DESCRIPTIONS +- COMMON-LISP::VECTOR-POP ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS +- ANSI-LOOP::LOOP-PATH-USER-DATA SYSTEM::S-DATA-SLOT-POSITION +- COMMON-LISP::BROADCAST-STREAM-STREAMS +- SYSTEM::LOGICAL-PATHNAMEP SYSTEM::BREAK-FORWARD-SEARCH-STACK +- SLOOP::SLOOP-SLOOP-MACRO COMMON-LISP::SIGNUM +- SYSTEM::RESET-TRACE-DECLARATIONS SYSTEM::CONTEXT-P +- SYSTEM::S-DATA-FROZEN SYSTEM::NUMBER-OF-DAYS-FROM-1900 +- SYSTEM::S-DATA-STATICP ANSI-LOOP::LOOP-PATH-FUNCTION +- SYSTEM::KNOWN-TYPE-P COMMON-LISP::PROVIDE SYSTEM::PNL1 +- ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD +- SYSTEM::COERCE-SLASH-TERMINATED COMMON-LISP::LOGICAL-PATHNAME +- SYSTEM::DIR-CONJ SYSTEM::BKPT-FORM +- SYSTEM::LOGICAL-PATHNAME-HOST-P SYSTEM::INSPECT-STRUCTURE +- ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED +- COMMON-LISP::FIND-ALL-SYMBOLS ++ SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::IHS-VISIBLE ++ SLOOP::LOOP-COLLECT-KEYWORD-P ANSI-LOOP::LOOP-TYPED-INIT ++ COMMON-LISP::VECTOR-POP SYSTEM::UNIQUE-ID + ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS +- ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++ SYSTEM::SIMPLE-ARRAY-P COMMON-LISP::ACOS SYSTEM::DBL-EVAL ++ SYSTEM::INSPECT-STRING SYSTEM::MLP ++ SYSTEM::INSTREAM-STREAM-NAME SYSTEM::WILD-NAMESTRING-P ++ ANSI-LOOP::LOOP-PATH-FUNCTION ++ SYSTEM::GET-STRING-INPUT-STREAM-INDEX ++ ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE SYSTEM::SEQTYPE ++ ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS ++ SYSTEM::BEST-ARRAY-ELEMENT-TYPE ++ ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA SYSTEM::S-DATA-FROZEN ++ SYSTEM::S-DATA-DOCUMENTATION SYSTEM::DWIM COMMON-LISP::SIGNUM ++ SYSTEM::FIND-DOCUMENTATION ANSI-LOOP::LOOP-COLLECTOR-HISTORY ++ ANSI-LOOP::LOOP-MAKE-PSETQ FPE::GREF SYSTEM::S-DATA-OFFSET ++ SYSTEM::WILD-PATH-ELEMENT-P SYSTEM::INSTREAM-P ++ COMMON-LISP::DIRECTORY-NAMESTRING SYSTEM::INSPECT-ARRAY ++ COMMON-LISP::ARRAY-DIMENSIONS ++ ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS ANSI-LOOP::LOOP-MINIMAX-P ++ SLOOP::RETURN-SLOOP-MACRO SYSTEM::WALK-THROUGH ++ SYSTEM::NEXT-STACK-FRAME SYSTEM::S-DATA-NAME COMMON-LISP::TANH ++ SYSTEM::BREAK-BACKWARD-SEARCH-STACK COMMON-LISP::TENTH ++ SYSTEM::INFO-NODE-FROM-POSITION FPE::ST-LOOKUP ++ COMMON-LISP::RESTART-NAME SYSTEM::S-DATA-TYPE ++ SYSTEM::BKPT-FILE-LINE COMMON-LISP::FIND-ALL-SYMBOLS ++ COMMON-LISP::FIFTH SLOOP::LOOP-LET-BINDINGS ++ COMMON-LISP::ECHO-STREAM-INPUT-STREAM ++ ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED ++ COMMON-LISP::PROBE-FILE SYSTEM::MAKE-FRAME ++ SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK ++ COMMON-LISP::COMPILE-FILE-PATHNAME ++ SYSTEM::PRINT-SYMBOL-APROPOS COMMON-LISP::LOGNOT ++ SYSTEM::INFO-GET-TAGS SYSTEM::SHORT-NAME ++ ANSI-LOOP::LOOP-MINIMAX-TYPE COMMON-LISP::SIXTH ++ COMMON-LISP::SECOND ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS ++ COMMON-LISP::TWO-WAY-STREAM-OUTPUT-STREAM ++ SYSTEM::S-DATA-INCLUDES SYSTEM::RESTART-INTERACTIVE-FUNCTION ++ SLOOP::TRANSLATE-NAME SYSTEM::PATCH-SHARP COMMON-LISP::ABS ++ ANSI-LOOP::LOOP-CONSTANTP SYSTEM::LEAP-YEAR-P ++ ANSI-LOOP::LOOP-UNIVERSE-ANSI ANSI-LOOP::LOOP-EMIT-BODY ++ COMMON-LISP::HOST-NAMESTRING COMMON-LISP::FIRST ++ SYSTEM::INSERT-BREAK-POINT ++ COMMON-LISP::LOAD-LOGICAL-PATHNAME-TRANSLATIONS ++ COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-PSEUDO-BODY ++ SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::S-DATA-HAS-HOLES ++ ANSI-LOOP::LOOP-COLLECTOR-NAME COMMON-LISP::FOURTH ++ SYSTEM::BKPT-FILE SYSTEM::CANONICALIZE-PATHNAME-DIRECTORY ++ SYSTEM::INSTREAM-STREAM SYSTEM::PNL1 SYSTEM::IHS-FNAME ++ SYSTEM::S-DATA-SLOT-POSITION SLOOP::PARSE-LOOP ++ SYSTEM::CHECK-TRACE-SPEC SYSTEM::S-DATA-CONSTRUCTORS ++ SYSTEM::S-DATA-STATICP SYSTEM::CONTEXT-P + COMMON-LISP::LOGICAL-PATHNAME-TRANSLATIONS +- SYSTEM::TRACE-ONE-PREPROCESS COMMON-LISP::CONSTANTLY +- COMMON-LISP::ACOS SYSTEM::S-DATA-OFFSET COMMON-LISP::ASINH +- SYSTEM::SHORT-NAME SYSTEM::S-DATA-INCLUDED SYSTEM::DBL-EVAL +- SYSTEM::BKPT-FUNCTION SYSTEM::INSPECT-NUMBER +- SYSTEM::GET-INSTREAM SYSTEM::SHOW-BREAK-POINT FPE::LOOKUP +- SYSTEM::NEXT-STACK-FRAME SYSTEM::INSPECT-ARRAY +- SYSTEM::S-DATA-RAW ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA +- SYSTEM::RESTART-REPORT-FUNCTION SYSTEM::TOGGLE-CASE +- SYSTEM::NODE-OFFSET SYSTEM::INSTREAM-P +- ANSI-LOOP::LOOP-PATH-NAMES SYSTEM::FREEZE-DEFSTRUCT +- COMMON-LISP::SEVENTH SYSTEM::SEARCH-STACK COMMON-LISP::SIXTH +- ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS FPE::GREF +- FPE::XMM-LOOKUP COMMON-LISP::HOST-NAMESTRING +- ANSI-LOOP::LOOP-TYPED-INIT ++ SYSTEM::INFO-GET-FILE COMMON-LISP::COMPLEMENT ++ SYSTEM::INSPECT-NUMBER SYSTEM::RESET-TRACE-DECLARATIONS ++ ANSI-LOOP::LOOP-PATH-P SLOOP::REPEAT-SLOOP-MACRO SYSTEM::DO-F ++ SYSTEM::INSPECT-PACKAGE SYSTEM::PATH-STREAM-NAME ++ SYSTEM::GET-INSTREAM COMMON-LISP::BYTE-SIZE ++ SYSTEM::RESTART-FUNCTION FPE::LOOKUP SYSTEM::S-DATA-CONC-NAME ++ COMMON-LISP::PROVIDE SYSTEM::S-DATA-NAMED SYSTEM::PRINT-FRS ++ ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE SYSTEM::NODE-OFFSET ++ ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::PRINT-IHS ++ ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS COMMON-LISP::TRUENAME ++ SYSTEM::BREAK-FORWARD-SEARCH-STACK ++ COMMON-LISP::CONCATENATED-STREAM-STREAMS SYSTEM::VERSION-PARSE ++ SYSTEM::INSPECT-CHARACTER SYSTEM::LOGICAL-PATHNAME-HOST-P ++ SYSTEM::DM-BAD-KEY SYSTEM::EXPAND-HOME-DIR ++ ANSI-LOOP::LOOP-PATH-USER-DATA ++ ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-SYMBOL ++ COMMON-LISP::INVOKE-DEBUGGER + SYSTEM::LOGICAL-PATHNAME-DESIGNATOR-P +- ANSI-LOOP::LOOP-DO-THEREIS COMMON-LISP::EIGHTH +- SYSTEM::UNIQUE-ID COMMON-LISP::THIRD +- COMMON-LISP::BYTE-POSITION COMMON-LISP::SYNONYM-STREAM-SYMBOL +- SYSTEM::PATCH-SHARP SYSTEM::PRINT-SYMBOL-APROPOS +- COMMON-LISP::LOGNOT SLOOP::REPEAT-SLOOP-MACRO +- COMMON-LISP::FOURTH SLOOP::SUBSTITUTE-SLOOP-BODY +- COMMON-LISP::ATANH SLOOP::LOOP-COLLECT-KEYWORD-P +- SYSTEM::SEQTYPE SYSTEM::RE-QUOTE-STRING COMMON-LISP::ISQRT +- SYSTEM::DO-F SYSTEM::S-DATA-HAS-HOLES +- ANSI-LOOP::LOOP-HACK-ITERATION ANSI-LOOP::LOOP-COLLECTOR-NAME +- COMMON-LISP::RESTART-NAME COMMON-LISP::DIRECTORY-NAMESTRING +- ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ACOSH +- SYSTEM::RESTART-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION +- COMMON-LISP::ASIN ANSI-LOOP::LOOP-LIST-COLLECTION +- SYSTEM::S-DATA-INCLUDES SYSTEM::GET-NEXT-VISIBLE-FUN +- COMMON-LISP::BYTE-SIZE COMMON-LISP::PATHNAME +- ANSI-LOOP::LOOP-MINIMAX-P SLOOP::PARSE-LOOP-INITIALLY +- COMMON-LISP::COSH SYSTEM::EXPAND-HOME-DIR +- COMMON-LISP::ECHO-STREAM-INPUT-STREAM +- SYSTEM::INSERT-BREAK-POINT SYSTEM::RESTART-TEST-FUNCTION +- SYSTEM::S-DATA-PRINT-FUNCTION SYSTEM::WILD-DIR-ELEMENT-P +- SYSTEM::S-DATA-NAMED COMMON-LISP::INVOKE-DEBUGGER +- COMMON-LISP::NAMESTRING ANSI-LOOP::LOOP-MAKE-DESETQ +- COMMON-LISP::COMPLEMENT SYSTEM::WALK-THROUGH +- COMMON-LISP::RATIONAL ANSI-LOOP::LOOP-MAXMIN-COLLECTION +- COMMON-LISP::DELETE-FILE ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS)) ++ COMMON-LISP::BYTE-POSITION COMMON-LISP::ISQRT COMMON-LISP::CIS ++ ANSI-LOOP::LOOP-COLLECTOR-CLASS ++ COMMON-LISP::SYNONYM-STREAM-SYMBOL ANSI-LOOP::LOOP-PATH-NAMES ++ SYSTEM::RE-QUOTE-STRING SYSTEM::INSPECT-STRUCTURE ++ COMMON-LISP::RATIONAL FPE::XMM-LOOKUP ++ SYSTEM::REWRITE-RESTART-CASE-CLAUSE ++ SYSTEM::S-DATA-PRINT-FUNCTION ++ SYSTEM::RESTRICT-STREAM-ELEMENT-TYPE SLOOP::SLOOP-SLOOP-MACRO ++ COMMON-LISP::NAMESTRING SYSTEM::ENSURE-DIR-STRING ++ COMMON-LISP::CONSTANTLY SLOOP::PARSE-LOOP-INITIALLY ++ SYSTEM::S-DATA-RAW SYSTEM::ADD-TO-HOTLIST SYSTEM::FRS-KIND ++ ANSI-LOOP::LOOP-MAXMIN-COLLECTION ++ ANSI-LOOP::LOOP-COLLECTOR-DATA SYSTEM::PROCESS-ARGS ++ SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::MAKE-KCL-TOP-RESTART ++ COMMON-LISP::ATANH ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD ++ COMMON-LISP::SINH ANSI-LOOP::LOOP-UNIVERSE-P ++ ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED ++ SYSTEM::S-DATA-INCLUDED COMMON-LISP::STREAM-EXTERNAL-FORMAT ++ SYSTEM::COMPUTING-ARGS-P SYSTEM::REAL-ASINH ++ ANSI-LOOP::LOOP-CONSTRUCT-RETURN ++ SYSTEM::S-DATA-SLOT-DESCRIPTIONS SYSTEM::FIX-LOAD-PATH ++ SYSTEM::CHECK-DECLARATIONS ++ ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS ++ SLOOP::POINTER-FOR-COLLECT COMMON-LISP::LOGICAL-PATHNAME ++ SYSTEM::CHDIR SYSTEM::IDESCRIBE ++ ANSI-LOOP::LOOP-MINIMAX-OPERATIONS COMMON-LISP::ACOSH ++ COMMON-LISP::NINTH ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE ++ ANSI-LOOP::LOOP-COLLECTOR-P SYSTEM::S-DATA-P SYSTEM::BKPT-FORM ++ COMMON-LISP::FILE-NAMESTRING SYSTEM::TERMINAL-INTERRUPT ++ SYSTEM::SETUP-INFO SLOOP::PARSE-NO-BODY ++ SYSTEM::DM-KEY-NOT-ALLOWED ANSI-LOOP::LOOP-EMIT-FINAL-VALUE ++ SYSTEM::FREEZE-DEFSTRUCT SYSTEM::DBL-RPL-LOOP ++ SYSTEM::TRACE-ONE-PREPROCESS ++ COMMON-LISP::BROADCAST-STREAM-STREAMS COMMON-LISP::THIRD ++ SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::SHOW-BREAK-POINT ++ COMMON-LISP::PATHNAME ANSI-LOOP::LOOP-DO-THEREIS ++ COMMON-LISP::FILE-AUTHOR ANSI-LOOP::LOOP-MAKE-DESETQ ++ SYSTEM::NC SYSTEM::NUMBER-OF-DAYS-FROM-1900 ++ SYSTEM::RESTART-TEST-FUNCTION SYSTEM::WHICH ++ ANSI-LOOP::DESTRUCTURING-SIZE COMMON-LISP::FILE-LENGTH)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- SYSTEM::BREAK-QUIT SYSTEM::BREAK-BDS SYSTEM::DBL-BACKTRACE +- SYSTEM::BREAK-LOCAL SYSTEM::INFO-ERROR +- SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-VS +- COMMON-LISP::CONTINUE COMMON-LISP::MUFFLE-WARNING +- SYSTEM::IHS-BACKTRACE ANSI-LOOP::LOOP-OPTIONAL-TYPE +- SYSTEM::BREAK-PREVIOUS SYSTEM::BREAK-NEXT)) ++ SYSTEM::BREAK-VS ANSI-LOOP::LOOP-OPTIONAL-TYPE ++ SYSTEM::BREAK-BDS SYSTEM::IHS-BACKTRACE SYSTEM::INFO-ERROR ++ SYSTEM::BREAK-LOCAL SYSTEM::SHOW-BREAK-VARIABLES ++ COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS ++ SYSTEM::BREAK-QUIT SYSTEM::DBL-BACKTRACE COMMON-LISP::CONTINUE ++ SYSTEM::BREAK-NEXT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++ SYSTEM::MAKE-KEYWORD)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807) +- COMMON-LISP::T) ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- SYSTEM::SMALLNTHCDR)) ++ SYSTEM::QUICK-SORT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- COMMON-LISP::HASH-TABLE) +- SYSTEM::CONTEXT-SPICE)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::BIGNTHCDR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE +- SYSTEM::S-DATA-LENGTH SYSTEM::THE-START)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ COMMON-LISP::FIND-RESTART COMMON-LISP::PATHNAME-HOST ++ SYSTEM::LINK-EXPAND COMMON-LISP::CONCATENATE COMMON-LISP::WARN ++ COMMON-LISP::FILE-POSITION ANSI-LOOP::LOOP-WARN ++ COMMON-LISP::PATHNAME-DIRECTORY COMMON-LISP::SBIT ++ COMMON-LISP::BIT ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES ++ COMMON-LISP::PATHNAME-TYPE COMMON-LISP::MAKE-ARRAY ++ ANSI-LOOP::LOOP-ERROR COMMON-LISP::DIRECTORY SYSTEM::DIR-PARSE ++ COMMON-LISP::TRANSLATE-LOGICAL-PATHNAME ++ SYSTEM::NTH-STACK-FRAME COMMON-LISP::REQUIRE COMMON-LISP::LOAD ++ SYSTEM::MGLIST COMMON-LISP::DELETE-DUPLICATES ++ COMMON-LISP::PATHNAME-VERSION COMMON-LISP::ENOUGH-NAMESTRING ++ SYSTEM::BAD-SEQ-LIMIT COMMON-LISP::REMOVE-DUPLICATES ++ COMMON-LISP::PATHNAME-NAME ++ COMMON-LISP::MAKE-STRING-INPUT-STREAM SLOOP::LOOP-ADD-TEMPS ++ SYSTEM::NLOAD SYSTEM::LIST-MATCHES ++ COMMON-LISP::ARRAY-ROW-MAJOR-INDEX ++ COMMON-LISP::ARRAY-IN-BOUNDS-P SYSTEM::BREAK-LEVEL ++ SYSTEM::PROCESS-SOME-ARGS SYSTEM::TO-REGEXP ++ COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::OPEN ++ SYSTEM::FILE-SEARCH COMMON-LISP::READ-BYTE ++ SYSTEM::FILE-TO-STRING SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR ++ COMMON-LISP::SIGNAL SYSTEM::MGSUB COMMON-LISP::WILD-PATHNAME-P ++ COMMON-LISP::PATHNAME-DEVICE SYSTEM::LOGICAL-PATHNAME-PARSE ++ COMMON-LISP::MERGE-PATHNAMES SYSTEM::INFO-SEARCH ++ COMMON-LISP::BIT-NOT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +- SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) +-(COMMON-LISP::MAPC +- (COMMON-LISP::LAMBDA (COMPILER::X) +- (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) +- COMMON-LISP::T)) +- '(SYSTEM::CONDITION-CLASS-P SYSTEM::WARNINGP SYSTEM::SI-CLASS-OF +- SYSTEM::SI-FIND-CLASS SYSTEM::DEFINE-STRUCTURE +- FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS +- SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::AUTOLOAD +- SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASS-NAME +- SYSTEM::TRACE-ONE SYSTEM::MAKE-ACCESS-FUNCTION +- SYSTEM::UNTRACE-ONE SYSTEM::SI-CLASSP SYSTEM::CONDITIONP +- SYSTEM::AUTOLOAD-MACRO)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::DO-REPL ++ SYSTEM::SOURCE-PORTION SYSTEM::RESTART-REPORT ++ SYSTEM::NEW-SEMI-COLON-READER SYSTEM::FIND-DOC ++ ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEWLINE ++ COMMON-LISP::RENAME-FILE SYSTEM::LIST-TOGGLE-CASE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- ((COMMON-LISP::INTEGER -9223372036854775808 +- 9223372036854775807)) +- COMMON-LISP::T) +- SYSTEM::GET-CONTEXT SYSTEM::PUSH-CONTEXT)) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ COMMON-LISP::REDUCE COMMON-LISP::STABLE-SORT ++ SYSTEM::PARSE-BODY SLOOP::FIND-IN-ORDERED-LIST ++ COMMON-LISP::SUBTYPEP COMMON-LISP::SORT)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::FIXNUM) +- SYSTEM::RELATIVE-LINE SYSTEM::LENEL SYSTEM::THE-END +- ANSI-LOOP::DUPLICATABLE-CODE-P SYSTEM::FASLINK +- SYSTEM::GET-NODE-INDEX)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::LIST-MERGE-SORT ANSI-LOOP::LOOP-GET-COLLECTION-INFO ++ SYSTEM::SHARP---READER SYSTEM::SHARP-S-READER ++ SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT ++ SYSTEM::SHARP-+-READER SYSTEM::READ-INSPECT-COMMAND)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- SLOOP::PARSE-ONE-WHEN-CLAUSE ANSI-LOOP::LOOP-DO-FINALLY +- SLOOP::LOOP-PEEK ANSI-LOOP::LOOP-DO-INITIALLY SLOOP::LOOP-POP +- ANSI-LOOP::LOOP-GET-PROGN SYSTEM::KCL-TOP-RESTARTS +- SYSTEM::INSPECT-READ-LINE SLOOP::PARSE-LOOP-WHEN +- ANSI-LOOP::LOOP-GET-FORM SYSTEM::DEFAULT-SYSTEM-BANNER +- SYSTEM::SET-UP-TOP-LEVEL SYSTEM::GET-INDEX-NODE +- ANSI-LOOP::LOOP-DO-DO ANSI-LOOP::LOOP-WHEN-IT-VARIABLE +- SYSTEM::SETUP-LINEINFO COMMON-LISP::TYPE-ERROR +- SYSTEM::READ-EVALUATED-FORM SYSTEM::INSPECT-INDENT-1 +- SLOOP::LOOP-UN-POP SLOOP::PARSE-LOOP-DO +- ANSI-LOOP::LOOP-DO-WITH SYSTEM::INSPECT-INDENT +- SYSTEM::GET-TEMP-DIR ANSI-LOOP::LOOP-ITERATION-DRIVER +- SYSTEM::WINE-TMP-REDIRECT SLOOP::PARSE-LOOP-COLLECT +- SYSTEM::DEFAULT-INFO-HOTLIST SLOOP::PARSE-LOOP1 +- SYSTEM::CLEANUP ANSI-LOOP::LOOP-DO-NAMED SYSTEM::DBL +- SYSTEM::ALL-TRACE-DECLARATIONS SYSTEM::TEST-ERROR +- ANSI-LOOP::LOOP-BIND-BLOCK ANSI-LOOP::LOOP-DO-REPEAT +- SYSTEM::ILLEGAL-BOA SYSTEM::SET-ENV SYSTEM::SET-CURRENT +- SYSTEM::INIT-BREAK-POINTS SYSTEM::GET-SIG-FN-NAME +- ANSI-LOOP::LOOP-DO-RETURN ANSI-LOOP::LOOP-CONTEXT +- SYSTEM::SHOW-RESTARTS SYSTEM::STEP-READ-LINE +- SLOOP::PARSE-LOOP-FOR SYSTEM::DM-TOO-MANY-ARGUMENTS +- COMMON-LISP::LISP-IMPLEMENTATION-VERSION SYSTEM::TOP-LEVEL +- ANSI-LOOP::LOOP-POP-SOURCE SYSTEM::DM-TOO-FEW-ARGUMENTS)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::PUSH-OPTIONAL-BINDING)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- ((COMMON-LISP::VECTOR COMMON-LISP::CHARACTER +- COMMON-LISP::*)) +- COMMON-LISP::T) +- SYSTEM::RESET-SYS-PATHS)) ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::TRACE-CALL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::VECTOR COMMON-LISP::T)) +- SYSTEM::CONTEXT-VEC)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::MASET)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::EXPAND-WILD-DIRECTORY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ SYSTEM::PARSE-DEFMACRO SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ SYSTEM::MME3)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ ((COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807) ++ COMMON-LISP::T) ++ COMMON-LISP::T) ++ SYSTEM::SMALLNTHCDR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +- SYSTEM::BREAK-HELP SYSTEM::BREAK-MESSAGE +- SYSTEM::SIMPLE-BACKTRACE ANSI-LOOP::LOOP-DO-FOR +- SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL +- SYSTEM::BREAK-RESUME)) +\ No newline at end of file ++ SYSTEM::GCL-TOP-LEVEL SYSTEM::BREAK-MESSAGE ++ SYSTEM::BREAK-RESUME SYSTEM::SIMPLE-BACKTRACE ++ SYSTEM::BREAK-HELP ANSI-LOOP::LOOP-DO-FOR ++ SYSTEM::BREAK-CURRENT)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ SYSTEM::S-DATA-LENGTH SYSTEM::THE-START SYSTEM::INSTREAM-LINE ++ SYSTEM::S-DATA-SIZE FPE::REG-LOOKUP)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++ SYSTEM::MATCH-BEGINNING SYSTEM::MATCH-END)) +\ No newline at end of file +--- gcl-2.6.12.orig/o/fasdump.c ++++ gcl-2.6.12/o/fasdump.c +@@ -598,7 +598,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd + if(tabl==Cnil) tabl=funcall_cfun(Lmake_hash_table,2,sKtest,sLeq); + else + check_type(tabl,t_hashtable);} +- check_type(str,t_stream); ++ massert(str==stream); + result=alloc_simple_vector(sizeof(struct fasd)/sizeof(int),aet_object); + array_allocself(result,1,Cnil); + {struct fasd *fd= (struct fasd *)result->v.v_self; +@@ -608,7 +608,7 @@ DEFUN_NEW("OPEN-FASD",object,fSopen_fasd + fd->eof=eof; + fd->index=small_fixnum(0); + fd->package=symbol_value(sLApackageA); +- fd->filepos = make_fixnum(file_position(stream)); ++ fd->filepos = make_fixnum(ftell(stream->sm.sm_fp)); + + SETUP_FASD_IN(fd); + if (direction==sKoutput){ +@@ -649,13 +649,13 @@ DEFUN_NEW("CLOSE-FASD",object,fSclose_fa + {clrhash(fd->table); + SETUP_FASD_IN(fd); + PUT_OP(d_end_of_file); +- {int i = file_position(fd->stream); ++ {int i = ftell(fd->stream->sm.sm_fp); + if(type_of(fd->filepos) == t_fixnum) +- { file_position_set(fd->stream,fix(fd->filepos) +2); ++ { fseek(fd->stream->sm.sm_fp,fix(fd->filepos)+2,SEEK_SET); + /* record the length of array needed to read the indices */ + PUT4(fix(fd->index)); + /* move back to where we were */ +- file_position_set(fd->stream,i); ++ fseek(fd->stream->sm.sm_fp,i,SEEK_SET); + }} + + } +--- gcl-2.6.12.orig/o/file.d ++++ gcl-2.6.12/o/file.d +@@ -167,7 +167,6 @@ BEGIN: + case smm_probe: + return(FALSE); + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -224,7 +223,6 @@ BEGIN: + case smm_probe: + return(FALSE); + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -272,7 +270,6 @@ BEGIN: + case smm_socket: + return (sLcharacter); + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -440,7 +437,7 @@ open_stream(object fn,enum smmode smm, o + x->sm.sm_buffer = 0; + x->sm.sm_object0 = sLcharacter; + x->sm.sm_object1 = vs_head; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_push(x); + +@@ -522,8 +519,6 @@ DEFUN_NEW("OPEN-STREAM-P",object,fLopen_ + void + close_stream(object strm) { + +- object x; +- + if (FFN(fLopen_stream_p)(strm)==Cnil) + return; + +@@ -569,24 +564,15 @@ close_stream(object strm) { + strm->sm.sm_fd = -1; + break; + +- case smm_file_synonym: + case smm_synonym: +- strm = symbol_value(strm->sm.sm_object0); +- if (type_of(strm) != t_stream) +- TYPE_ERROR(strm,sLstream); +- close_stream(strm); + break; + + case smm_broadcast: + case smm_concatenated: +- for (x = strm->sm.sm_object0; !endp(x); x = x->c.c_cdr) +- close_stream(x->c.c_car); + break; + + case smm_two_way: + case smm_echo: +- close_stream(STREAM_INPUT_STREAM(strm)); +- close_stream(STREAM_OUTPUT_STREAM(strm)); + break; + + case smm_string_input: +@@ -616,7 +602,6 @@ DEFUN_NEW("INTERACTIVE-STREAM-P",object, + return Ct; + return Cnil; + break; +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -656,7 +641,7 @@ object istrm, ostrm; + strm->sm.sm_buffer = 0; + STREAM_INPUT_STREAM(strm) = istrm; + STREAM_OUTPUT_STREAM(strm) = ostrm; +- strm->sm.sm_int0 = strm->sm.sm_int1 = 0; ++ strm->sm.sm_int = 0; + strm->sm.sm_flags=0; + return(strm); + } +@@ -672,24 +657,30 @@ object istrm, ostrm; + return(strm); + } + +-object +-make_string_input_stream(strng, istart, iend) +-object strng; +-int istart, iend; +-{ +- object strm; ++DEFUN_NEW("MAKE-STRING-INPUT-STREAM-INT",object,fSmake_string_input_stream_int,SI,3,3,NONE,OO,II,OO,OO, ++ (object strng,fixnum istart,fixnum iend),"") { ++ ++ object strm; ++ ++ strm = alloc_object(t_stream); ++ strm->sm.sm_mode = (short)smm_string_input; ++ strm->sm.sm_fp = NULL; ++ strm->sm.sm_buffer = 0; ++ STRING_STREAM_STRING(strm) = strng; ++ strm->sm.sm_object1 = OBJNULL; ++ STRING_INPUT_STREAM_NEXT(strm)= istart; ++ STRING_INPUT_STREAM_END(strm)= iend; ++ strm->sm.sm_flags=0; ++ ++ RETURN1(strm); + +- strm = alloc_object(t_stream); +- strm->sm.sm_mode = (short)smm_string_input; +- strm->sm.sm_fp = NULL; +- strm->sm.sm_buffer = 0; +- STRING_STREAM_STRING(strm) = strng; +- strm->sm.sm_object1 = OBJNULL; +- STRING_INPUT_STREAM_NEXT(strm)= istart; +- STRING_INPUT_STREAM_END(strm)= iend; +- strm->sm.sm_flags=0; +- return(strm); + } ++#ifdef STATIC_FUNCTION_POINTERS ++object ++fSmake_string_input_stream_int(object x,fixnum y,fixnum z) { ++ return FFN(fSmake_string_input_stream_int)(x,y,z); ++} ++#endif + + DEFUN_NEW("STRING-INPUT-STREAM-P",object,fSstring_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + return type_of(x)==t_stream && x->sm.sm_mode == (short)smm_string_input ? Ct : Cnil; +@@ -722,7 +713,7 @@ int line_length; + strm->sm.sm_buffer = 0; + STRING_STREAM_STRING(strm) = strng; + strm->sm.sm_object1 = OBJNULL; +- strm->sm.sm_int0 = STREAM_FILE_COLUMN(strm) = 0; ++ strm->sm.sm_int = 0; + strm->sm.sm_flags=0; + vs_reset; + return(strm); +@@ -777,7 +768,6 @@ BEGIN: + /* strm->sm.sm_int0++; */ + return(c==EOF ? c : (c&0377)); + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -880,7 +870,6 @@ BEGIN: + /* --strm->sm.sm_int0; */ /* use ftell now for position */ + break; + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -982,7 +971,6 @@ BEGIN: + + break; + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1093,7 +1081,6 @@ BEGIN: + #endif + closed_stream(strm); + break; +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1182,7 +1169,6 @@ BEGIN: + case smm_probe: + return(FALSE); + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + check_stream(strm); +@@ -1308,7 +1294,6 @@ BEGIN: + #endif + return TRUE; + +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1345,136 +1330,6 @@ BEGIN: + } + + int +-file_position(strm) +-object strm; +-{ +-BEGIN: +- switch (strm->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_io: +- /* return(strm->sm.sm_int0); */ +- if (strm->sm.sm_fp == NULL) +- closed_stream(strm); +- return(ftell(strm->sm.sm_fp)); +- case smm_socket: +- return -1; +- +- +- case smm_string_output: +- return(STRING_STREAM_STRING(strm)->st.st_fillp); +- +- case smm_file_synonym: +- case smm_synonym: +- strm = symbol_value(strm->sm.sm_object0); +- if (type_of(strm) != t_stream) +- FEwrong_type_argument(sLstream, strm); +- goto BEGIN; +- +- case smm_probe: +- case smm_broadcast: +- case smm_concatenated: +- case smm_two_way: +- case smm_echo: +- case smm_string_input: +- return(-1); +- +- default: +- error("illegal stream mode"); +- return(-1); +- } +-} +- +-int +-file_position_set(strm, disp) +-object strm; +-int disp; +-{ +-BEGIN: +- switch (strm->sm.sm_mode) { +- case smm_socket: +- return -1; +- case smm_input: +- case smm_output: +- case smm_io: +- +- if (fseek(strm->sm.sm_fp, disp, 0) < 0) +- return(-1); +- /* strm->sm.sm_int0 = disp; */ +- return(0); +- +- case smm_string_output: +- if (disp < STRING_STREAM_STRING(strm)->st.st_fillp) { +- STRING_STREAM_STRING(strm)->st.st_fillp = disp; +- /* strm->sm.sm_int0 = disp; */ +- } else { +- disp -= STRING_STREAM_STRING(strm)->st.st_fillp; +- while (disp-- > 0) +- writec_stream(' ', strm); +- } +- return(0); +- +- case smm_file_synonym: +- case smm_synonym: +- strm = symbol_value(strm->sm.sm_object0); +- if (type_of(strm) != t_stream) +- FEwrong_type_argument(sLstream, strm); +- goto BEGIN; +- +- case smm_probe: +- case smm_broadcast: +- case smm_concatenated: +- case smm_two_way: +- case smm_echo: +- case smm_string_input: +- return(-1); +- +- default: +- error("illegal stream mode"); +- return(-1); +- } +-} +- +-static int +-file_length(strm) +-object strm; +-{ +-BEGIN: +- switch (strm->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_io: +- +- if (strm->sm.sm_fp == NULL) +- closed_stream(strm); +- return(file_len(strm->sm.sm_fp)); +- +- +- +- case smm_file_synonym: +- case smm_synonym: +- strm = symbol_value(strm->sm.sm_object0); +- if (type_of(strm) != t_stream) +- FEwrong_type_argument(sLstream, strm); +- goto BEGIN; +- +- case smm_socket: +- case smm_probe: +- case smm_broadcast: +- case smm_concatenated: +- case smm_two_way: +- case smm_echo: +- case smm_string_input: +- case smm_string_output: +- return(-1); +- +- default: +- error("illegal stream mode"); +- return(-1); +- } +-} +- +-int + file_column(object strm) { + int i; + object x; +@@ -1491,7 +1346,6 @@ BEGIN: + case smm_two_way: + strm=STREAM_OUTPUT_STREAM(strm); + goto BEGIN; +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -1558,22 +1412,6 @@ load(const char *s) { + + + +-static int +-file_synonym_stream_p(object x) { +- switch(x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_io: +- case smm_probe: +- case smm_file_synonym: +- return 1; +- case smm_synonym: +- return file_synonym_stream_p(x->sm.sm_object0->s.s_dbind); +- default: +- return 0; +- } +-} +- + LFD(Lmake_synonym_stream)() + { + object x; +@@ -1581,12 +1419,12 @@ LFD(Lmake_synonym_stream)() + check_arg(1); + check_type_sym(&vs_base[0]); + x = alloc_object(t_stream); +- x->sm.sm_mode = file_synonym_stream_p(vs_base[0]) ? (short)smm_file_synonym : (short)smm_synonym; ++ x->sm.sm_mode = (short)smm_synonym; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_base[0] = x; + } +@@ -1610,7 +1448,7 @@ LFD(Lmake_broadcast_stream)() + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_base[0] = x; + } +@@ -1634,7 +1472,7 @@ LFD(Lmake_concatenated_stream)() + x->sm.sm_buffer = 0; + x->sm.sm_object0 = vs_base[0]; + x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_int = 0; + x->sm.sm_flags=0; + vs_base[0] = x; + } +@@ -1667,32 +1505,6 @@ LFD(Lmake_echo_stream)() + vs_popp; + } + +-@(static defun make_string_input_stream (strng &o istart iend) +- int s, e; +-@ +- check_type_string(&strng); +- if (istart == Cnil) +- s = 0; +- else if (type_of(istart) != t_fixnum) +- goto E; +- else +- s = fix(istart); +- if (iend == Cnil) +- e = strng->st.st_fillp; +- else if (type_of(iend) != t_fixnum) +- goto E; +- else +- e = fix(iend); +- if (s < 0 || e > strng->st.st_fillp || s > e) +- goto E; +- @(return `make_string_input_stream(strng, s, e)`) +- +-E: +- FEerror("~S and ~S are illegal as :START and :END~%\ +-for the string ~S.", +- 3, istart, iend, strng); +-@) +- + @(static defun make_string_output_stream (&k element_type) + @ + element_type=Cnil;/*FIXME*/ +@@ -1724,12 +1536,29 @@ LFD(siLoutput_stream_string)() + vs_base[0] = vs_base[0]->sm.sm_object0; + } + ++object ++file_stream(object x) { ++ if (type_of(x)==t_stream) ++ switch(x->sm.sm_mode) { ++ case smm_input: ++ case smm_output: ++ case smm_io: ++ case smm_probe: ++ return x; ++ case smm_synonym: ++ return file_stream(x->sm.sm_object0->s.s_dbind); ++ default: ++ break; ++ } ++ return Cnil; ++} ++ + DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- RETURN1(type_of(x)==t_stream && file_synonym_stream_p(x) ? Ct : Cnil); ++ RETURN1(file_stream(x)!=Cnil ? Ct : Cnil); + } + + DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +- RETURN1(type_of(x)==t_stream && (x->sm.sm_mode==smm_file_synonym || x->sm.sm_mode==smm_synonym) ? Ct : Cnil); ++ RETURN1(type_of(x)==t_stream && x->sm.sm_mode==smm_synonym ? Ct : Cnil); + } + + DEFUN_NEW("TERMINAL-INPUT-STREAM-P",object,fSterminal_input_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +@@ -1802,43 +1631,6 @@ LFD(Lstream_element_type)() + @) + + +-@(defun file_position (file_stream &o position) +- int i=0; +-@ +- check_type_stream(&file_stream); +- if (position == Cnil) { +- i = file_position(file_stream); +- if (i < 0) +- @(return Cnil) +- @(return `make_fixnum(i)`) +- } else { +- if (position == sKstart) +- i = 0; +- else if (position == sKend) +- i = file_length(file_stream); +- else if (type_of(position) != t_fixnum || +- (i = fix((position))) < 0) +- FEerror("~S is an illegal file position~%\ +-for the file-stream ~S.", +- 2, position, file_stream); +- if (file_position_set(file_stream, i) < 0) +- @(return Cnil) +- @(return Ct) +- } +-@) +- +-LFD(Lfile_length)() +-{ +- int i; +- +- check_arg(1); +- check_type_stream(&vs_base[0]); +- i = file_length(vs_base[0]); +- if (i < 0) +- vs_base[0] = Cnil; +- else +- vs_base[0] = make_fixnum(i); +-} + + object sLAload_pathnameA; + DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,""); +@@ -1911,17 +1703,6 @@ DEFUN_NEW("LOAD-FASL",object,fSload_fasl + + } + +-static void +-FFN(siLget_string_input_stream_index)() +-{ +- check_arg(1); +- check_type_stream(&vs_base[0]); +- if ((enum smmode)vs_base[0]->sm.sm_mode != smm_string_input) +- FEerror("~S is not a string-input stream.", 1, vs_base[0]); +- vs_base[0] = make_fixnum(STRING_INPUT_STREAM_NEXT(vs_base[0])); +-} +- +- + LFD(siLmake_string_output_stream_from_string)() + { + object strng, strm; +@@ -2042,7 +1823,6 @@ int out; + if (type_of(strm) != t_stream) + FEwrong_type_argument(sLstream, strm); + switch (strm->sm.sm_mode){ +- case smm_file_synonym: + case smm_synonym: + strm = symbol_value(strm->sm.sm_object0); + if (type_of(strm) != t_stream) +@@ -2203,7 +1983,7 @@ object async; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = list(3,server,host,port); + x->sm.sm_object1 = 0; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; ++ x->sm.sm_int = 0; + x->sm.sm_flags=0; + SOCKET_STREAM_FD(x)= fd; + SET_STREAM_FLAG(x,mode,1); +@@ -2466,8 +2246,7 @@ gcl_init_file(void) + #ifdef UNIX + = make_simple_string("stdin"); + #endif +- standard_input->sm.sm_int0 = 0; /* unused */ +- standard_input->sm.sm_int1 = 0; /* unused */ ++ standard_input->sm.sm_int = 0; /* unused */ + standard_input->sm.sm_flags=0; + + standard_output = alloc_object(t_stream); +@@ -2479,8 +2258,7 @@ gcl_init_file(void) + #ifdef UNIX + = make_simple_string("stdout"); + #endif +- standard_output->sm.sm_int0 = 0; /* unused */ +- STREAM_FILE_COLUMN(standard_output) = 0; ++ standard_output->sm.sm_int = 0; /* unused */ + standard_output->sm.sm_flags=0; + + terminal_io = standard +@@ -2488,12 +2266,12 @@ gcl_init_file(void) + enter_mark_origin(&terminal_io); + + x = alloc_object(t_stream); +- x->sm.sm_mode = (short)smm_file_synonym; ++ x->sm.sm_mode = (short)smm_synonym; + x->sm.sm_fp = NULL; + x->sm.sm_buffer = 0; + x->sm.sm_object0 = sLAterminal_ioA; + x->sm.sm_object1 = OBJNULL; +- x->sm.sm_int0 = x->sm.sm_int1 = 0; /* unused */ ++ x->sm.sm_int = 0; /* unused */ + x->sm.sm_flags=0; + standard_io = x; + enter_mark_origin(&standard_io); +@@ -2561,8 +2339,6 @@ gcl_init_file_function() + Lmake_concatenated_stream); + make_function("MAKE-TWO-WAY-STREAM", Lmake_two_way_stream); + make_function("MAKE-ECHO-STREAM", Lmake_echo_stream); +- make_function("MAKE-STRING-INPUT-STREAM", +- Lmake_string_input_stream); + make_function("MAKE-STRING-OUTPUT-STREAM", + Lmake_string_output_stream); + make_function("GET-OUTPUT-STREAM-STRING", +@@ -2581,11 +2357,6 @@ gcl_init_file_function() + make_function("STREAM-ELEMENT-TYPE", Lstream_element_type); + make_function("CLOSE", Lclose); + +- make_function("FILE-POSITION", Lfile_position); +- make_function("FILE-LENGTH", Lfile_length); +- +- make_si_function("GET-STRING-INPUT-STREAM-INDEX", +- siLget_string_input_stream_index); + make_si_function("MAKE-STRING-OUTPUT-STREAM-FROM-STRING", + siLmake_string_output_stream_from_string); + make_si_function("COPY-STREAM", siLcopy_stream); +--- gcl-2.6.12.orig/o/gbc.c ++++ gcl-2.6.12/o/gbc.c +@@ -627,7 +627,6 @@ mark_object1(object x) { + } + break; + +- case smm_file_synonym: + case smm_synonym: + mark_object(x->sm.sm_object0); + break; +--- gcl-2.6.12.orig/o/pathname.d ++++ gcl-2.6.12/o/pathname.d +@@ -83,6 +83,11 @@ DEFUN_NEW("C-STREAM-OBJECT1",object,fSc_ + RETURN1(x->sm.sm_object1); + } + ++DEFUN_NEW("C-SET-STREAM-OBJECT0",object,fSc_set_stream_object0,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { ++ x->sm.sm_object0=y; ++ RETURN1(x); ++} ++ + DEFUN_NEW("C-SET-STREAM-OBJECT1",object,fSc_set_stream_object1,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { + x->sm.sm_object1=y; + RETURN1(x); +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -1260,7 +1260,6 @@ int level; + write_ch('>'); + break; + +- case smm_file_synonym: + case smm_synonym: + write_str("#sm.sm_object0, level); +--- gcl-2.6.12.orig/o/read.d ++++ gcl-2.6.12/o/read.d +@@ -2204,7 +2204,7 @@ object x; + object in; + vs_mark; + +- in = make_string_input_stream(x, 0, x->st.st_fillp); ++ in = fSmake_string_input_stream_int(x, 0, x->st.st_fillp); + vs_push(in); + preserving_whitespace_flag = FALSE; + detect_eos_flag = FALSE; +--- gcl-2.6.12.orig/o/run_process.c ++++ gcl-2.6.12/o/run_process.c +@@ -434,7 +434,7 @@ enum smmode smm; + + stream->sm.sm_object0 = sLcharacter; + stream->sm.sm_object1 = host_l; +- stream->sm.sm_int0 = stream->sm.sm_int1 = 0; ++ stream->sm.sm_int = 0; + stream->sm.sm_flags=0; + vs_push(stream); + setup_stream_buffer(stream); +@@ -503,8 +503,7 @@ make_socket_pair() + stream_in->sm.sm_mode = smm_input; + stream_in->sm.sm_fp = fp1; + stream_in->sm.sm_buffer = 0; +- stream_in->sm.sm_int0 = sockets_in[1]; +- stream_in->sm.sm_int1 = 0; ++ stream_in->sm.sm_int = sockets_in[1]; + stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL; + stream_in->sm.sm_flags = 0; + stream_out = (object) alloc_object(t_stream); +@@ -513,8 +512,7 @@ make_socket_pair() + stream_out->sm.sm_buffer = 0; + setup_stream_buffer(stream_in); + setup_stream_buffer(stream_out); +- stream_out->sm.sm_int0 = sockets_out[1]; +- stream_out->sm.sm_int1 = 0; ++ stream_out->sm.sm_int = sockets_out[1]; + stream_out->sm.sm_flags = 0; + stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL; + stream = make_two_way_stream(stream_in, stream_out); +@@ -538,8 +536,8 @@ char **argv; + int fdout; + if (istream->sm.sm_fp == NULL || ostream->sm.sm_fp == NULL) + FEerror("Cannot spawn process with given stream", 0); +- fdin = istream->sm.sm_int0; +- fdout = ostream->sm.sm_int0; ++ fdin = istream->sm.sm_int; ++ fdout = ostream->sm.sm_int; + if (pfork() == 0) + { /* the child --- replace standard in and out with descriptors given */ + close(0); +--- gcl-2.6.12.orig/o/sockets.c ++++ gcl-2.6.12/o/sockets.c +@@ -518,16 +518,6 @@ DEFUN_NEW("SET-SIGIO-FOR-FD",object,fSse + + } + +-DEFUN_NEW("RESET-STRING-INPUT-STREAM",object,fSreset_string_input_stream,SI,4,4,NONE,OO,OI,IO,OO,(object strm,object string,fixnum start,fixnum end), +- "Reuse a string output STREAM by setting its output to STRING \ +-and positioning the ouput/input to start at START and end at END") +- +-{ strm->sm.sm_object0 = string; +- strm->sm.sm_int0 = start; +- strm->sm.sm_int1 = end; +- return strm; +-} +- + DEFUN_NEW("CHECK-STATE-INPUT",object,fScheck_state_input,SI,2,2,NONE,OO,IO,OO,OO,(object osfd,fixnum timeout), + "") + { +--- gcl-2.6.12.orig/o/string.d ++++ gcl-2.6.12/o/string.d +@@ -564,28 +564,33 @@ LFD(Lnstring_capitalize)() { casefun = c + @(return `coerce_to_string(x)`) + @) + +-static void +-FFN(siLstring_concatenate)() +-{ +- int narg, i, l, m; +- object *v; ++DEFUN_NEW("STRING-CONCATENATE",object,fLstring_concatenate,SI,0,63,NONE,OO,OO,OO,OO,(object first,...),"") { ++ ++ fixnum i,l,m,narg=VFUN_NARGS; ++ object x; ++ va_list ap; ++ ++ va_start(ap,first); ++ vs_base=vs_top; ++ for (l=i=0;ist.st_fillp; ++ } ++ va_end(ap); ++ ++ { ++ object *p; ++ BEGIN_NO_INTERRUPT; ++ x=alloc_simple_string(l); ++ (x)->st.st_self = alloc_relblock(l); ++ for (l=0,p=vs_base;pst.st_fillp)>=0;p++,l+=m) ++ memcpy(x->st.st_self+l,(*p)->st.st_self,m); ++ END_NO_INTERRUPT; ++ ++ } ++ ++ RETURN1(x); + +- narg = vs_top - vs_base; +- for (i = 0, l = 0; i < narg; i++) { +- vs_base[i] = coerce_to_string(vs_base[i]); +- l += vs_base[i]->st.st_fillp; +- } +- v = vs_top; +- {BEGIN_NO_INTERRUPT; +- vs_push(alloc_simple_string(l)); +- (*v)->st.st_self = alloc_relblock(l); +- for (i = 0, l = 0; i < narg; i++) +- for (m = 0; m < vs_base[i]->st.st_fillp; m++) +- (*v)->st.st_self[l++] +- = vs_base[i]->st.st_self[m]; +- vs_base[0] = *v; +- vs_top = vs_base + 1; +- END_NO_INTERRUPT;} + } + + void +@@ -628,6 +633,4 @@ gcl_init_string_function() + make_function("NSTRING-CAPITALIZE", Lnstring_capitalize); + make_function("STRING", Lstring); + +- make_si_function("STRING-CONCATENATE", +- siLstring_concatenate); + } +--- gcl-2.6.12.orig/o/unixfsys.c ++++ gcl-2.6.12/o/unixfsys.c +@@ -55,7 +55,7 @@ get_string(object x) { + case smm_probe: + case smm_io: + return get_string(x->sm.sm_object1); +- case smm_file_synonym: ++ case smm_synonym: + return get_string(x->sm.sm_object0->s.s_dbind); + } + } +@@ -169,24 +169,6 @@ DEF_ORDINARY("DIRECTORY",sKdirectory,KEY + DEF_ORDINARY("LINK",sKlink,KEYWORD,""); + DEF_ORDINARY("FILE",sKfile,KEYWORD,""); + +-object +-file_stream(object x) { +- if (type_of(x)==t_stream) +- switch(x->sm.sm_mode) { +- case smm_input: +- case smm_output: +- case smm_io: +- case smm_probe: +- return x; +- case smm_synonym: +- return file_stream(x->sm.sm_object0->s.s_dbind); +- default: +- break; +- } +- return Cnil; +-} +- +- + DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + + struct stat ss; +--- gcl-2.6.12.orig/pcl/sys-proclaim.lisp ++++ gcl-2.6.12/pcl/sys-proclaim.lisp +@@ -2,29 +2,19 @@ + (COMMON-LISP::IN-PACKAGE "PCL") + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) +- PCL::CACHE-LIMIT-FN PCL::FAST-METHOD-CALL-FUNCTION +- PCL::METHOD-CALL-FUNCTION)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) ++ COMMON-LISP::T) ++ PCL::%CCLOSURE-ENV-NTHCDR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) +- PCL::DISPATCH-DFUN-INFO PCL::DEFAULT-METHOD-ONLY-DFUN-INFO +- PCL::MAKE-CACHE PCL::BOOTSTRAP-BUILT-IN-CLASSES +- PCL::RENEW-SYS-FILES PCL::SHOW-EMF-CALL-TRACE PCL::MAKE-CPD +- PCL::BOOTSTRAP-META-BRAID PCL::CACHES-TO-ALLOCATE +- PCL::LIST-ALL-DFUNS PCL::INITIAL-DISPATCH-DFUN-INFO +- PCL::INITIAL-DFUN-INFO PCL::%%ALLOCATE-INSTANCE--CLASS +- PCL::MAKE-ARG-INFO PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2 +- PCL::SHOW-FREE-CACHE-VECTORS PCL::UPDATE-DISPATCH-DFUNS +- PCL::GET-EFFECTIVE-METHOD-GENSYM PCL::IN-THE-COMPILER-P +- PCL::SHOW-DFUN-CONSTRUCTORS PCL::NO-METHODS-DFUN-INFO +- PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST +- PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 +- PCL::STRUCTURE-FUNCTIONS-EXIST-P)) ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) ++ PCL::GET-WRAPPER-CACHE-NUMBER)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) +- PCL::CACHE-FIELD)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ PCL::NON-NEGATIVE-FIXNUM) ++ PCL::CACHE-NLINES PCL::CACHE-MASK PCL::CACHE-SIZE ++ PCL::CACHE-MAX-LOCATION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +@@ -32,296 +22,344 @@ + PCL::CACHE-VECTOR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::INTEGER 1 256)) +- PCL::CACHE-LINE-SIZE)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::ACCESSOR-VALUES-INTERNAL ++ PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION ++ PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++ PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++ PCL::CHECK-METHOD-ARG-INFO ++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION ++ PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++ PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION ++ PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++ ITERATE::WALK-GATHERING-BODY ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER ++ PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++ PCL::SLOT-BOUNDP-USING-CLASS-DFUN WALKER::WALK-FORM-INTERNAL ++ PCL::LOAD-LONG-DEFCOMBIN PCL::MAKE-FINAL-CACHING-DFUN ++ PCL::EMIT-READER/WRITER ++ PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION ++ PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS ++ PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES1 ++ PCL::GENERATING-LISP PCL::GET-CLASS-SLOT-VALUE-1 ++ PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN PCL::CACHE-MISS-VALUES ++ WALKER::WALK-LET-IF ++ PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| ++ PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++ PCL::CHECKING-MISS ITERATE::EXPAND-INTO-LET ++ PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION ++ PCL::CONSTANT-VALUE-MISS ITERATE::RENAME-VARIABLES ++ PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ PCL::SET-SLOT-VALUE ++ PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| ++ PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| ++ PCL::CONVERT-METHODS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::INTEGER 1 255)) +- PCL::CACHE-NKEYS)) ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| ++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| ++ PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| ++ PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| ++ PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::ADD-METHOD-DECLARATIONS ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++ PCL::WALK-METHOD-LAMBDA ++ PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::GET-ACCESSOR-METHOD-FUNCTION ++ PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| ++ PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++ PCL::GENERATE-DISCRIMINATION-NET ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++ PCL::LOAD-SHORT-DEFCOMBIN ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++ PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::REAL-MAKE-METHOD-LAMBDA PCL::SET-CLASS-SLOT-VALUE-1 ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITION ++ PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++ PCL::ACCESSOR-MISS PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++ PCL::ACCESSOR-VALUES ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| ++ PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++ PCL::EMIT-CHECKING-OR-CACHING-FUNCTION ++ PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION ++ PCL::MAKE-FINAL-CHECKING-DFUN ++ PCL::MAKE-SHARED-INITIALIZE-FORM-LIST ++ PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| ++ PCL::EMIT-CHECKING-OR-CACHING ++ PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| ++ PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN ++ PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION ++ PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| ++ PCL::ORDER-SPECIALIZERS ++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ PCL::MAKE-N-N-ACCESSOR-DFUN ++ PCL::GET-SIMPLE-INITIALIZATION-FUNCTION ++ PCL::MAKE-FINAL-ACCESSOR-DFUN ++ PCL::GET-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-ACCESSOR-TABLE ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION PCL::MAKE-CHECKING-DFUN ++ PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS ++ PCL::MAKE-DEFAULT-INITARGS-FORM-LIST PCL::REAL-ADD-METHOD ++ PCL::SLOT-VALUE-OR-DEFAULT PCL::LOAD-DEFGENERIC PCL::CPL-ERROR ++ WALKER::NESTED-WALK-FORM PCL::TYPES-FROM-ARGUMENTS ++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION ++ PCL::GENERATE-DISCRIMINATION-NET-INTERNAL ++ PCL::CACHE-MISS-VALUES-INTERNAL ++ PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN WALKER::WALK-DECLARATIONS ++ PCL::GET-SECONDARY-DISPATCH-FUNCTION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| ++ PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| ++ ITERATE::ITERATE-TRANSFORM-BODY)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ ITERATE::RENAME-LET-BINDINGS ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::*) ++ PCL::REAL-MAKE-A-METHOD)) + (COMMON-LISP::MAPC + (COMMON-LISP::LAMBDA (COMPILER::X) + (COMMON-LISP::SETF +- (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) ++ (COMMON-LISP::GET COMPILER::X 'COMPILER::PROCLAIMED-CLOSURE) + COMMON-LISP::T)) + '(PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1 +- PCL::FDEFINE-CAREFULLY PCL::TRACE-METHOD-INTERNAL)) ++ PCL::TRACE-METHOD-INTERNAL PCL::FDEFINE-CAREFULLY)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) +- PCL::SYMBOL-APPEND)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) ++ PCL::ANALYZE-LAMBDA-LIST PCL::GET-DISPATCH-FUNCTION ++ PCL::PARSE-DEFMETHOD PCL::MAKE-DISPATCH-DFUN ++ PCL::EMIT-IN-CHECKING-CACHE-P PCL::EMIT-ONE-INDEX-READERS ++ PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-ONE-CLASS-READER ++ PCL::GENERIC-FUNCTION-NAME-P PCL::DEFAULT-CODE-CONVERTER ++ PCL::CLASS-EQ-TYPE PCL::CONVERT-TO-SYSTEM-TYPE ++ PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE ++ PCL::GET-GENERIC-FUNCTION-INFO PCL::EARLY-METHOD-FUNCTION ++ PCL::FIND-STRUCTURE-CLASS PCL::PCL-DESCRIBE ++ PCL::NET-CODE-CONVERTER PCL::PARSE-METHOD-GROUP-SPECIFIER ++ PCL::TYPE-FROM-SPECIALIZER PCL::EMIT-TWO-CLASS-WRITER ++ PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EMIT-ONE-CLASS-WRITER ++ PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA ++ PCL::SPECIALIZER-FROM-TYPE PCL::EARLY-COLLECT-INHERITANCE ++ PCL::EMIT-TWO-CLASS-READER PCL::FIND-WRAPPER ++ PCL::*NORMALIZE-TYPE PCL::EMIT-ONE-INDEX-WRITERS ++ PCL::STRUCTURE-WRAPPER PCL::MAKE-FINAL-DISPATCH-DFUN)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) +- PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL +- PCL::GENERIC-CLOBBERS-FUNCTION PCL::STRUCTURE-SLOTD-TYPE +- WALKER::GET-WALKER-TEMPLATE PCL::COMPILE-LAMBDA-UNCOMPILED +- PCL::EXTRACT-LAMBDA-LIST PCL::DEFAULT-METHOD-ONLY-P +- PCL::DISPATCH-CACHE PCL::STRUCTURE-SLOTD-NAME +- PCL::FAST-METHOD-CALL-P PCL::SFUN-P +- PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST +- PCL::EARLY-CLASS-DEFINITION PCL::CONSTANT-SYMBOL-P +- PCL::ARG-INFO-LAMBDA-LIST WALKER::ENV-LEXICAL-VARIABLES +- PCL::INTERN-EQL-SPECIALIZER PCL::PARSE-SPECIALIZERS +- PCL::%STD-INSTANCE-WRAPPER PCL::UPDATE-ALL-C-A-M-GF-INFO +- PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION +- PCL::STORE-FGEN PCL::COMPUTE-MCASE-PARAMETERS +- PCL::INTERNED-SYMBOL-P PCL::MAKE-CALL-METHODS +- PCL::USE-CACHING-DFUN-P PCL::LEGAL-CLASS-NAME-P +- WALKER::VARIABLE-GLOBALLY-SPECIAL-P PCL::FUNCTION-RETURNING-T +- PCL::METHOD-FUNCTION-METHOD PCL::GET-BUILT-IN-CLASS-SYMBOL +- PCL::DEFAULT-STRUCTURE-TYPE PCL::GF-DFUN-INFO PCL::CACHING-P +- PCL::FREE-CACHE-VECTOR PCL::ONE-CLASS-CACHE +- PCL::DEFAULT-TEST-CONVERTER PCL::UNDEFMETHOD-1 +- PCL::MAKE-INITFUNCTION PCL::GET-CACHE-VECTOR +- PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::GF-INFO-FAST-MF-P +- PCL::ECD-SOURCE PCL::INITIAL-P PCL::ARG-INFO-APPLYP +- PCL::ARG-INFO-KEYWORDS +- PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION +- PCL::CACHING-DFUN-COST PCL::INITIAL-DISPATCH-P PCL::EVAL-FORM +- PCL::MAKE-CONSTANT-FUNCTION PCL::FUNCTION-RETURNING-NIL +- PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::FGEN-GENSYMS +- PCL::EXPAND-SHORT-DEFCOMBIN WALKER::ENV-LOCK +- PCL::INITIALIZE-INFO-CACHED-CONSTANTS +- PCL::INITIALIZE-INFO-WRAPPER +- PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME PCL::TWO-CLASS-INDEX +- PCL::ONE-INDEX-ACCESSOR-TYPE +- PCL::EARLY-COLLECT-DEFAULT-INITARGS WALKER::ENV-WALK-FORM +- PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::MAKE-FUNCTION-INLINE +- PCL::FLUSH-CACHE-VECTOR-INTERNAL +- PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION +- PCL::FGEN-GENERATOR PCL::CONSTANT-VALUE-P +- PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION +- PCL::EARLY-CLASS-PRECEDENCE-LIST PCL::SLOT-BOUNDP-SYMBOL +- PCL::ARG-INFO-NUMBER-OPTIONAL +- PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::GET-PV-CELL-FOR-CLASS +- PCL::CHECKING-FUNCTION PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P +- PCL::INITIAL-DISPATCH-CACHE PCL::STRUCTURE-SVUC-METHOD +- PCL::NO-METHODS-CACHE PCL::GF-DFUN-CACHE PCL::%CCLOSURE-ENV +- PCL::CONSTANT-VALUE-CACHE PCL::BUILT-IN-WRAPPER-OF +- PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P +- PCL::EARLY-COLLECT-CPL COMMON-LISP::CLASS-OF +- PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::SYMBOL-PKG-NAME +- PCL::GDEFINITION +- PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION +- PCL::ACCESSOR-DFUN-INFO-CACHE PCL::EXTRACT-SPECIALIZER-NAMES +- PCL::CHECK-WRAPPER-VALIDITY PCL::MAKE-INITIAL-DFUN +- PCL::WRAPPER-FIELD PCL::EARLY-SLOT-DEFINITION-LOCATION +- PCL::EARLY-GF-P PCL::GF-INFO-STATIC-C-A-M-EMF PCL::LOOKUP-FGEN +- PCL::MAKE-PV-TYPE-DECLARATION +- PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS +- PCL::EARLY-METHOD-CLASS +- PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION +- WALKER::ENV-DECLARATIONS PCL::ALLOCATE-CACHE-VECTOR +- PCL::FUNCTION-PRETTY-ARGLIST +- PCL::EARLY-CLASS-DIRECT-SUBCLASSES +- PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P +- PCL::MAKE-CLASS-EQ-PREDICATE PCL::ECD-OTHER-INITARGS +- PCL::GBOUNDP PCL::METHOD-FUNCTION-PV-TABLE +- WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE +- PCL::MAKE-INSTANCE-FUNCTION-SYMBOL +- PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::FIND-CYCLE-REASONS PCL::FGEN-TEST +- PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::FREE-CACHE +- PCL::TYPE-CLASS PCL::INITIAL-CACHE +- PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS +- PCL::STRUCTURE-SLOTD-WRITER-FUNCTION +- PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION +- PCL::EARLY-COLLECT-SLOTS PCL::LIST-DFUN +- PCL::EXPAND-MAKE-INSTANCE-FORM PCL::N-N-CACHE +- PCL::MAKE-TYPE-PREDICATE PCL::INTERN-FUNCTION-NAME +- PCL::GET-MAKE-INSTANCE-FUNCTIONS WALKER::ENV-WALK-FUNCTION +- PCL::TWO-CLASS-CACHE PCL::MAKE-CALLS-TYPE-DECLARATION +- PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION +- PCL::INITIALIZE-INFO-KEY PCL::GF-LAMBDA-LIST +- ITERATE::VARIABLES-FROM-LET PCL::COMPUTE-CLASS-SLOTS +- PCL::DFUN-ARG-SYMBOL PCL::CHECKING-P PCL::ARG-INFO-P +- PCL::INITIALIZE-INFO-CACHED-RI-VALID-P PCL::CHECKING-CACHE +- PCL::METHOD-FUNCTION-PLIST PCL::STRUCTURE-OBJECT-P +- PCL::ARG-INFO-PRECEDENCE PCL::ONE-CLASS-INDEX +- PCL::STD-INSTANCE-P PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST +- PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::EARLY-SLOT-DEFINITION-NAME PCL::UNPARSE-SPECIALIZERS +- PCL::STRUCTURE-TYPE-P PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE +- PCL::PV-TABLEP PCL::CLASS-FROM-TYPE +- PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::STRUCTURE-TYPE +- PCL::MAKE-EQL-PREDICATE PCL::TWO-CLASS-ACCESSOR-TYPE +- PCL::DEFAULT-STRUCTURE-INSTANCE-P +- PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME +- PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::GFS-OF-TYPE +- PCL::DEFAULT-STRUCTUREP PCL::EARLY-CLASS-NAME-OF +- PCL::%STD-INSTANCE-SLOTS PCL::ONE-INDEX-INDEX PCL::WRAPPER-OF +- PCL::ARG-INFO-VALID-P PCL::KEYWORD-SPEC-NAME +- PCL::METHOD-CALL-P PCL::SHOW-DFUN-COSTS PCL::DFUN-INFO-CACHE +- PCL::DEFAULT-CONSTANT-CONVERTER ITERATE::SEQUENCE-ACCESSOR +- PCL::COUNT-DFUN PCL::EXPAND-LONG-DEFCOMBIN +- PCL::CACHING-DFUN-INFO PCL::INITIALIZE-INFO-CACHED-VALID-P +- PCL::FAST-INSTANCE-BOUNDP-P PCL::ARG-INFO-METATYPES +- PCL::EXTRACT-PARAMETERS PCL::GF-INFO-C-A-M-EMF-STD-P +- PCL::FINAL-ACCESSOR-DFUN-TYPE PCL::GMAKUNBOUND +- PCL::FAST-METHOD-CALL-ARG-INFO PCL::COMPUTE-LINE-SIZE +- PCL::ONE-INDEX-CACHE PCL::NO-METHODS-P +- PCL::COMPUTE-STD-CPL-PHASE-2 +- PCL::COMPLICATED-INSTANCE-CREATION-METHOD +- PCL::MAKE-PERMUTATION-VECTOR PCL::CONSTANT-VALUE-DFUN-INFO +- PCL::TWO-CLASS-WRAPPER1 PCL::MAP-ALL-GENERIC-FUNCTIONS +- PCL::CLASS-PREDICATE SYSTEM::%STRUCTURE-NAME +- PCL::RESET-CLASS-INITIALIZE-INFO +- PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::EARLY-CLASS-NAME +- PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL +- PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::SLOT-READER-SYMBOL +- PCL::ARG-INFO-NKEYS PCL::METHOD-CALL-CALL-METHOD-ARGS +- PCL::CCLOSUREP PCL::DEFAULT-METHOD-ONLY-CACHE +- PCL::NEXT-WRAPPER-FIELD PCL::SLOT-WRITER-SYMBOL +- PCL::ACCESSOR-DFUN-INFO-P +- PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL +- PCL::EXTRACT-REQUIRED-PARAMETERS PCL::FORMAT-CYCLE-REASONS +- PCL::UNENCAPSULATED-FDEFINITION +- PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::ONE-CLASS-P +- PCL::ECD-METACLASS PCL::METHOD-LL->GENERIC-FUNCTION-LL +- PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::ONE-INDEX-P +- PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST +- PCL::ECD-CANONICAL-SLOTS +- PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P +- PCL::INITIALIZE-INFO-CACHED-NEW-KEYS +- PCL::STRUCTURE-SLOTD-READER-FUNCTION +- PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST +- PCL::DISPATCH-P PCL::LIST-LARGE-CACHE +- PCL::FAST-METHOD-CALL-PV-CELL PCL::GET-MAKE-INSTANCE-FUNCTION +- PCL::DNET-METHODS-P PCL::STRUCTURE-SLOTD-INIT-FORM +- PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::ONE-CLASS-ACCESSOR-TYPE +- PCL::RESET-INITIALIZE-INFO PCL::STANDARD-SVUC-METHOD +- PCL::DEFAULT-CONSTANTP PCL::UPDATE-C-A-M-GF-INFO +- PCL::ONE-INDEX-DFUN-INFO-CACHE PCL::EARLY-CLASS-SLOTS +- PCL::CPD-SUPERS PCL::FGEN-GENERATOR-LAMBDA +- PCL::ECD-SUPERCLASS-NAMES PCL::ECD-CLASS-NAME PCL::SETFBOUNDP +- PCL::GET-SETF-FUNCTION-NAME PCL::DFUN-INFO-P +- PCL::SLOT-VECTOR-SYMBOL PCL::INITIALIZE-INFO-P +- PCL::TWO-CLASS-P PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE +- PCL::COPY-CACHE PCL::MAKE-PV-TABLE-TYPE-DECLARATION +- PCL::SORT-CALLS PCL::STRUCTURE-SLOT-BOUNDP PCL::%FBOUNDP +- PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::UPDATE-GF-INFO +- PCL::WRAPPER-FOR-STRUCTURE PCL::FUNCALLABLE-INSTANCE-P +- PCL::CPD-CLASS PCL::EARLY-METHOD-STANDARD-ACCESSOR-P +- PCL::SORT-SLOTS PCL::CANONICAL-SLOT-NAME +- PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +- PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::%SYMBOL-FUNCTION +- PCL::EARLY-METHOD-LAMBDA-LIST PCL::ONE-INDEX-DFUN-INFO-INDEX +- PCL::N-N-ACCESSOR-TYPE PCL::CACHING-CACHE +- PCL::EARLY-CLASS-SLOTDS PCL::ONE-INDEX-DFUN-INFO-P +- SYSTEM::%COMPILED-FUNCTION-NAME +- PCL::BOOTSTRAP-CLASS-PREDICATES PCL::NET-TEST-CONVERTER +- PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS PCL::TWO-CLASS-WRAPPER0 +- PCL::MAP-SPECIALIZERS PCL::EARLY-GF-NAME PCL::N-N-P +- PCL::FGEN-SYSTEM PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P +- PCL::UPDATE-GFS-OF-CLASS PCL::ONE-CLASS-WRAPPER0 +- PCL::CPD-AFTER +- PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION +- PCL::CACHE-P PCL::EARLY-METHOD-QUALIFIERS PCL::CHECK-CACHE +- PCL::FORCE-CACHE-FLUSHES PCL::CACHE-OWNER +- PCL::COMPILE-LAMBDA-DEFERRED PCL::ARG-INFO-KEY/REST-P)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) ++ PCL::|__si::MAKE-INITIAL| PCL::|__si::MAKE-ARG-INFO| ++ PCL::STRING-APPEND PCL::|__si::MAKE-ONE-INDEX| ++ PCL::MAKE-INITIALIZE-INFO PCL::MAKE-FAST-METHOD-CALL ++ PCL::|__si::MAKE-STD-INSTANCE| ++ PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| ++ PCL::|__si::MAKE-CONSTANT-VALUE| PCL::|__si::MAKE-N-N| ++ PCL::FIX-EARLY-GENERIC-FUNCTIONS PCL::INTERN-PV-TABLE ++ PCL::FALSE PCL::|__si::MAKE-DFUN-INFO| ++ PCL::|__si::MAKE-CACHING| PCL::MAKE-PV-TABLE ++ PCL::MAKE-METHOD-CALL PCL::TRUE PCL::MAKE-PROGN ++ PCL::|__si::MAKE-CACHE| ++ PCL::|STRUCTURE-OBJECT class constructor| ++ PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| ++ PCL::|__si::MAKE-NO-METHODS| PCL::|__si::MAKE-ONE-CLASS| ++ PCL::|__si::MAKE-PV-TABLE| PCL::PV-WRAPPERS-FROM-PV-ARGS ++ WALKER::UNBOUND-LEXICAL-FUNCTION PCL::|__si::MAKE-TWO-CLASS| ++ PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| ++ PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| ++ PCL::MAKE-FAST-INSTANCE-BOUNDP ++ PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL ++ PCL::|__si::MAKE-CHECKING| PCL::|__si::MAKE-INITIAL-DISPATCH| ++ PCL::|__si::MAKE-DISPATCH|)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) +- COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES +- PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD +- COMMON-LISP::METHOD-COMBINATION-ERROR)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION) ++ PCL::METHOD-CALL-FUNCTION PCL::FAST-METHOD-CALL-FUNCTION ++ PCL::CACHE-LIMIT-FN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN) ++ PCL::CACHE-VALUEP)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- PCL::NON-NEGATIVE-FIXNUM) +- PCL::CACHE-MAX-LOCATION PCL::CACHE-NLINES PCL::CACHE-SIZE +- PCL::CACHE-MASK)) ++ (COMMON-LISP::INTEGER 1 255)) ++ PCL::CACHE-NKEYS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::INTEGER 1 256)) ++ PCL::CACHE-LINE-SIZE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T)) ++ PCL::SYMBOL-APPEND)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) ++ (COMMON-LISP::*)) ++ PCL::SORT-APPLICABLE-METHODS PCL::SORT-METHODS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION +- ITERATE::SIMPLE-EXPAND-ITERATE-FORM PCL::ADD-DIRECT-SUBCLASSES +- PCL::PROCLAIM-DEFMETHOD PCL::UPDATE-INITIALIZE-INFO-INTERNAL +- PCL::RAISE-METATYPE PCL::CLASS-CAN-PRECEDE-P +- WALKER::VARIABLE-SPECIAL-P PCL::GF-MAKE-FUNCTION-FROM-EMF +- PCL::|SETF PCL METHOD-FUNCTION-PLIST| ++ PCL::COMPUTE-CALLS PCL::SET-STRUCTURE-SVUC-METHOD ++ PCL::UPDATE-STD-OR-STR-METHODS PCL::SET-METHODS ++ WALKER::NOTE-LEXICAL-BINDING ++ ITERATE::SIMPLE-EXPAND-ITERATE-FORM ++ PCL::|SETF PCL METHOD-FUNCTION-PLIST| PCL::SAUT-NOT-PROTOTYPE ++ PCL::VALUE-FOR-CACHING PCL::PROCLAIM-DEFMETHOD ++ PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST ++ PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::METHODS-CONVERTER ++ PCL::DEAL-WITH-ARGUMENTS-OPTION ++ PCL::UPDATE-ALL-PV-TABLE-CACHES ++ PCL::MAP-PV-TABLE-REFERENCES-OF PCL::UPDATE-CLASS ++ PCL::FIND-STANDARD-II-METHOD ++ PCL::METHOD-FUNCTION-RETURNING-NIL ++ PCL::REDIRECT-EARLY-FUNCTION-INTERNAL PCL::UPDATE-CPL ++ PCL::QUALIFIER-CHECK-RUNTIME PCL::COMPUTE-STD-CPL ++ PCL::COMPUTE-CONSTANTS PCL::ADD-FORMS PCL::AUGMENT-TYPE ++ PCL::MEMF-CONSTANT-CONVERTER PCL::SWAP-WRAPPERS-AND-SLOTS ++ PCL::SET-WRAPPER PCL::GET-KEY-ARG PCL::MAKE-PLIST ++ PCL::MAKE-PV-TABLE-INTERNAL ITERATE::EXTRACT-SPECIAL-BINDINGS ++ PCL::SAUT-NOT-EQL WALKER::VARIABLE-SYMBOL-MACRO-P ++ PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION + PCL::SET-FUNCTION-PRETTY-ARGLIST ++ PCL::GF-MAKE-FUNCTION-FROM-EMF PCL::FIND-SLOT-DEFINITION ++ PCL::SET-STANDARD-SVUC-METHOD PCL::ADD-TO-CVECTOR ++ PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS COMMON-LISP::REMOVE-METHOD ++ PCL::CHECKING-DFUN-INFO PCL::PARSE-QUALIFIER-PATTERN ++ PCL::%SET-CCLOSURE-ENV PCL::MAKE-CDXR + PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS ++ PCL::NET-CONSTANT-CONVERTER PCL::|SETF PCL FIND-CLASS| ++ PCL::METHOD-FUNCTION-RETURNING-T PCL::CHANGE-CLASS-INTERNAL ++ PCL::MAKE-DFUN-ARG-LIST PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER ++ PCL::MAKE-STD-WRITER-METHOD-FUNCTION ITERATE::MV-SETQ ++ PCL::MAKE-EARLY-ACCESSOR PCL::GET-KEY-ARG1 ++ PCL::ADD-DIRECT-SUBCLASSES PCL::DO-SATISFIES-DEFTYPE ++ PCL::N-N-DFUN-INFO PCL::CLASSES-HAVE-COMMON-SUBCLASS-P ++ PCL::SAUT-NOT-CLASS PCL::CANONICALIZE-DEFCLASS-OPTION + PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST +- PCL::DEAL-WITH-ARGUMENTS-OPTION WALKER::NOTE-DECLARATION +- PCL::MAKE-CLASS-PREDICATE PCL::VALUE-FOR-CACHING +- PCL::EMIT-1-NIL-DLAP PCL::MAKE-CAXR PCL::SYMBOL-LESSP +- PCL::GET-KEY-ARG1 PCL::ADD-FORMS +- PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +- PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER +- PCL::CLASSES-HAVE-COMMON-SUBCLASS-P PCL::N-N-DFUN-INFO +- PCL::CANONICALIZE-SLOT-SPECIFICATION +- PCL::REDIRECT-EARLY-FUNCTION-INTERNAL +- PCL::UPDATE-STD-OR-STR-METHODS PCL::%SET-CCLOSURE-ENV +- PCL::QUALIFIER-CHECK-RUNTIME +- PCL::MAKE-STD-READER-METHOD-FUNCTION +- PCL::ADD-SLOT-ACCESSORS PCL::ADD-TO-CVECTOR +- PCL::COMPUTE-LAYOUT PCL::DESTRUCTURE-INTERNAL +- PCL::SUPERCLASSES-COMPATIBLE-P +- PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION ITERATE::MV-SETQ +- PCL::COMPUTE-STD-CPL PCL::SET-METHODS PCL::CHECKING-DFUN-INFO +- ITERATE::EXTRACT-SPECIAL-BINDINGS PCL::SWAP-WRAPPERS-AND-SLOTS +- PCL::CANONICALIZE-DEFCLASS-OPTION PCL::MAKE-CDXR +- PCL::PRINTING-RANDOM-THING-INTERNAL COMMON-LISP::ADD-METHOD ++ WALKER::VARIABLE-LEXICAL-P WALKER::ENVIRONMENT-FUNCTION ++ PCL::PV-TABLE-LOOKUP PCL::DESTRUCTURE-INTERNAL ++ PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION ++ PCL::REMOVE-SLOT-ACCESSORS ++ PCL::|SETF PCL FIND-CLASS-PREDICATE| ++ PCL::|SETF PCL GDEFINITION| PCL::MAKE-DFUN-LAMBDA-LIST ++ PCL::CANONICALIZE-SLOT-SPECIFICATION WALKER::WALK-REPEAT-EVAL + PCL::STANDARD-INSTANCE-ACCESS +- SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::FIND-SLOT-DEFINITION ++ PCL::PRINTING-RANDOM-THING-INTERNAL PCL::REMTAIL ++ PCL::ACCESSOR-MISS-FUNCTION PCL::COMPUTE-LAYOUT + PCL::CLASS-MIGHT-PRECEDE-P +- PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::SAUT-NOT-EQL +- PCL::SET-WRAPPER PCL::SET-STANDARD-SVUC-METHOD +- PCL::SAUT-NOT-PROTOTYPE PCL::ACCESSOR-MISS-FUNCTION +- PCL::NO-SLOT PCL::REMTAIL PCL::PV-WRAPPERS-FROM-ALL-ARGS +- PCL::UPDATE-CLASS PCL::AUGMENT-TYPE PCL::MAKE-EARLY-ACCESSOR +- PCL::MAKE-PLIST PCL::MEC-ALL-CLASSES-INTERNAL +- PCL::MAKE-STD-WRITER-METHOD-FUNCTION +- PCL::PARSE-QUALIFIER-PATTERN PCL::MEMF-CONSTANT-CONVERTER +- PCL::|SETF PCL FIND-CLASS-PREDICATE| +- PCL::MAKE-UNORDERED-METHODS-EMF WALKER::ENVIRONMENT-FUNCTION +- PCL::MEC-ALL-CLASS-LISTS PCL::SAUT-NOT-CLASS-EQ +- PCL::DO-SATISFIES-DEFTYPE PCL::SET-STRUCTURE-SVUC-METHOD +- PCL::MAKE-DLAP-LAMBDA-LIST PCL::METHOD-FUNCTION-RETURNING-T +- PCL::COMPUTE-CALLS PCL::REMOVE-SLOT-ACCESSORS +- PCL::UPDATE-ALL-PV-TABLE-CACHES PCL::MAKE-DFUN-LAMBDA-LIST +- WALKER::NOTE-LEXICAL-BINDING PCL::REMOVE-DIRECT-SUBCLASSES +- PCL::MAP-PV-TABLE-REFERENCES-OF PCL::COMPUTE-CONSTANTS +- PCL::METHOD-FUNCTION-RETURNING-NIL PCL::METHODS-CONVERTER +- PCL::PV-TABLE-LOOKUP PCL::DESCRIBE-PACKAGE +- COMMON-LISP::SLOT-EXISTS-P PCL::MAKE-PV-TABLE-INTERNAL +- PCL::SAUT-NOT-CLASS PCL::|SETF PCL FIND-CLASS| +- PCL::UPDATE-INITS PCL::UPDATE-CPL +- PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION +- PCL::COMPUTE-PV WALKER::VARIABLE-LEXICAL-P +- PCL::PROCLAIM-DEFGENERIC PCL::MAKE-DFUN-ARG-LIST +- PCL::GET-KEY-ARG COMMON-LISP::REMOVE-METHOD +- PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS PCL::VARIABLE-CLASS +- PCL::UPDATE-SLOTS PCL::SYMBOL-OR-CONS-LESSP +- PCL::MEC-ALL-CLASSES PCL::LIST-EQ +- PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION +- WALKER::WALK-REPEAT-EVAL WALKER::ENVIRONMENT-MACRO +- WALKER::VARIABLE-SYMBOL-MACRO-P +- PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST +- PCL::BOOTSTRAP-SLOT-INDEX PCL::PLIST-VALUE +- PCL::CHANGE-CLASS-INTERNAL PCL::NET-CONSTANT-CONVERTER +- PCL::|SETF PCL GDEFINITION| PCL::FIND-STANDARD-II-METHOD)) ++ PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION ++ SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::PLIST-VALUE ++ PCL::MAKE-CAXR PCL::MAKE-DLAP-LAMBDA-LIST ++ PCL::MAKE-STD-READER-METHOD-FUNCTION WALKER::ENVIRONMENT-MACRO ++ PCL::UPDATE-SLOTS PCL::VARIABLE-CLASS ++ PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION PCL::LIST-EQ ++ PCL::ADD-SLOT-ACCESSORS PCL::SAUT-NOT-CLASS-EQ PCL::COMPUTE-PV ++ PCL::PV-WRAPPERS-FROM-ALL-ARGS PCL::UPDATE-INITS ++ PCL::MEC-ALL-CLASS-LISTS PCL::RAISE-METATYPE ++ WALKER::NOTE-DECLARATION PCL::EMIT-1-NIL-DLAP ++ PCL::BOOTSTRAP-SLOT-INDEX PCL::SUPERCLASSES-COMPATIBLE-P ++ PCL::MEC-ALL-CLASSES-INTERNAL COMMON-LISP::SLOT-EXISTS-P ++ PCL::DESCRIBE-PACKAGE PCL::NO-SLOT PCL::PROCLAIM-DEFGENERIC ++ COMMON-LISP::ADD-METHOD PCL::MAKE-UNORDERED-METHODS-EMF ++ PCL::MEC-ALL-CLASSES PCL::SYMBOL-OR-CONS-LESSP ++ PCL::UPDATE-INITIALIZE-INFO-INTERNAL PCL::CLASS-CAN-PRECEDE-P ++ PCL::SYMBOL-LESSP PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION ++ PCL::MAKE-CLASS-PREDICATE WALKER::VARIABLE-SPECIAL-P ++ PCL::REMOVE-DIRECT-SUBCLASSES)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::*) +- WALKER::WALK-FORM PCL::MAKE-INSTANCE-1 +- PCL::EXTRACT-DECLARATIONS PCL::GET-FUNCTION +- WALKER::MACROEXPAND-ALL PCL::ALLOCATE-STRUCTURE-INSTANCE +- PCL::MAKE-FINAL-DFUN-INTERNAL PCL::GET-METHOD-FUNCTION +- PCL::COERCE-TO-CLASS PCL::MAP-ALL-CLASSES PCL::ENSURE-CLASS +- PCL::PARSE-METHOD-OR-SPEC COMMON-LISP::ENSURE-GENERIC-FUNCTION +- PCL::MAKE-CACHING-DFUN PCL::GET-FUNCTION1 +- PCL::GET-DFUN-CONSTRUCTOR PCL::MAKE-CONSTANT-VALUE-DFUN +- PCL::MAKE-METHOD-FUNCTION-INTERNAL PCL::COMPILE-LAMBDA +- PCL::PARSE-SPECIALIZED-LAMBDA-LIST PCL::DISPATCH-DFUN-COST +- PCL::MAKE-METHOD-LAMBDA-INTERNAL)) ++ PCL::MAKE-METHOD-FUNCTION-INTERNAL ++ PCL::MAKE-FINAL-DFUN-INTERNAL WALKER::MACROEXPAND-ALL ++ COMMON-LISP::ENSURE-GENERIC-FUNCTION ++ PCL::MAKE-METHOD-LAMBDA-INTERNAL PCL::MAKE-CONSTANT-VALUE-DFUN ++ PCL::GET-FUNCTION PCL::EXTRACT-DECLARATIONS ++ PCL::COERCE-TO-CLASS PCL::PARSE-METHOD-OR-SPEC ++ PCL::DISPATCH-DFUN-COST PCL::PARSE-SPECIALIZED-LAMBDA-LIST ++ PCL::MAP-ALL-CLASSES PCL::COMPILE-LAMBDA PCL::ENSURE-CLASS ++ PCL::GET-METHOD-FUNCTION WALKER::WALK-FORM ++ PCL::ALLOCATE-STRUCTURE-INSTANCE PCL::GET-FUNCTION1 ++ PCL::MAKE-CACHING-DFUN PCL::MAKE-INSTANCE-1 ++ PCL::GET-DFUN-CONSTRUCTOR)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION (COMMON-LISP::T) +@@ -329,270 +367,405 @@ + PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::VECTOR COMMON-LISP::CHARACTER ++ COMMON-LISP::*)) ++ PCL::CAPITALIZE-WORDS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T) ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1 PCL::SHOW-EMF-CALL-TRACE ++ PCL::CACHES-TO-ALLOCATE PCL::MAKE-CACHE ++ PCL::SHOW-FREE-CACHE-VECTORS PCL::MAKE-ARG-INFO ++ PCL::NO-METHODS-DFUN-INFO PCL::STRUCTURE-FUNCTIONS-EXIST-P ++ PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST ++ PCL::BOOTSTRAP-BUILT-IN-CLASSES ++ PCL::%%ALLOCATE-INSTANCE--CLASS PCL::DISPATCH-DFUN-INFO ++ PCL::INITIAL-DISPATCH-DFUN-INFO PCL::BOOTSTRAP-META-BRAID ++ PCL::UPDATE-DISPATCH-DFUNS PCL::LIST-ALL-DFUNS ++ PCL::DEFAULT-METHOD-ONLY-DFUN-INFO PCL::RENEW-SYS-FILES ++ PCL::IN-THE-COMPILER-P PCL::GET-EFFECTIVE-METHOD-GENSYM ++ PCL::MAKE-CPD PCL::INITIAL-DFUN-INFO ++ PCL::SHOW-DFUN-CONSTRUCTORS ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::FIXNUM) ++ PCL::ZERO)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) + COMMON-LISP::T) +- PCL::FIND-CLASS-FROM-CELL PCL::GET-METHOD-FUNCTION-PV-CELL +- PCL::PROBE-CACHE PCL::NAMED-OBJECT-PRINT-FUNCTION +- PCL::PRECOMPUTE-EFFECTIVE-METHODS +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE +- PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::MAKE-EMF-FROM-METHOD +- PCL::EMIT-MISS PCL::REAL-ENSURE-GF-USING-CLASS--NULL +- PCL::RECORD-DEFINITION WALKER::CONVERT-MACRO-TO-LAMBDA +- PCL::INITIALIZE-INFO PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION +- PCL::METHOD-FUNCTION-GET PCL::FIND-CLASS-PREDICATE-FROM-CELL +- PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS +- PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 PCL::GET-DECLARATION +- PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION +- PCL::MAP-CACHE)) ++ PCL::PRINT-DFUN-INFO)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::*) ++ PCL::FIND-FREE-CACHE-LINE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::COMPUTE-CACHE-PARAMETERS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) ++ PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-WRITERS ++ PCL::EMIT-N-N-READERS)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::MAKE-FINAL-DFUN PCL::SET-ARG-INFO PCL::TRACE-METHOD ++ PCL::MAKE-SPECIALIZABLE WALKER::WALKER-ENVIRONMENT-BIND-1 ++ ITERATE::FUNCTION-LAMBDA-P COMMON-LISP::FIND-CLASS ++ PCL::MAKE-WRAPPER PCL::UPDATE-DFUN ++ PCL::MAKE-TYPE-PREDICATE-NAME PCL::PV-TABLE-LOOKUP-PV-ARGS ++ PCL::USE-CONSTANT-VALUE-DFUN-P WALKER::RELIST ++ PCL::MAKE-EARLY-GF PCL::INITIALIZE-METHOD-FUNCTION ++ PCL::FIND-CLASS-CELL PCL::USE-DISPATCH-DFUN-P ++ PCL::FIND-CLASS-PREDICATE PCL::ALLOCATE-STANDARD-INSTANCE ++ PCL::INITIALIZE-INTERNAL-SLOT-GFS ITERATE::MAYBE-WARN ++ PCL::ALLOCATE-FUNCALLABLE-INSTANCE ++ PCL::EARLY-METHOD-SPECIALIZERS WALKER::RELIST* PCL::SET-DFUN)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) ++ COMMON-LISP::*) ++ PCL::SLOT-UNBOUND-INTERNAL ITERATE::PARSE-DECLARATIONS ++ PCL::EMIT-CACHING PCL::COMPUTE-STD-CPL-PHASE-1 ++ PCL::INITIAL-DFUN PCL::INSURE-DFUN PCL::EMIT-CHECKING ++ PCL::COMPUTE-TEST PCL::COMPUTE-CODE PCL::MAKE-DIRECT-SLOTD ++ PCL::SAUT-CLASS COMMON-LISP::SLOT-MAKUNBOUND ++ PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::INVOKE-EMF ++ PCL::*SUBTYPEP PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P ++ PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES ++ PCL::REAL-REMOVE-METHOD PCL::SAUT-PROTOTYPE ++ PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN ++ COMMON-LISP::SLOT-BOUNDP PCL::FORM-LIST-TO-LISP ++ PCL::CPL-INCONSISTENT-ERROR PCL::EMIT-DEFAULT-ONLY-FUNCTION ++ PCL::ENSURE-CLASS-VALUES PCL::CHECK-INITARGS-VALUES ++ PCL::SAUT-EQL PCL::SPLIT-DECLARATIONS ++ PCL::UPDATE-SLOT-VALUE-GF-INFO PCL::SAUT-AND ++ PCL::SLOT-NAME-LISTS-FROM-SLOTS ++ PCL::MAKE-INSTANCE-FUNCTION-TRAP PCL::EMIT-DEFAULT-ONLY ++ PCL::SAUT-NOT PCL::SAUT-CLASS-EQ COMMON-LISP::SLOT-VALUE ++ PCL::DESTRUCTURE PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P ++ PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL ++ PCL::CLASS-APPLICABLE-USING-CLASS-P PCL::SDFUN-FOR-CACHING ++ PCL::SET-FUNCTION-NAME)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) ++ PCL::ARG-INFO-NUMBER-REQUIRED PCL::CACHING-LIMIT-FN ++ PCL::PV-CACHE-LIMIT-FN PCL::ONE-INDEX-LIMIT-FN ++ PCL::PV-TABLE-PV-SIZE PCL::CACHE-COUNT PCL::DEFAULT-LIMIT-FN ++ PCL::CPD-COUNT PCL::CHECKING-LIMIT-FN ++ PCL::N-N-ACCESSORS-LIMIT-FN PCL::EARLY-CLASS-SIZE ++ PCL::FAST-INSTANCE-BOUNDP-INDEX)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) ++ PCL::POWER-OF-TWO-CEILING)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::GET-CACHE-FROM-CACHE)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM COMMON-LISP::T) ++ COMMON-LISP::FIXNUM) ++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE) ++ PCL::CACHE-FIELD)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) ++ (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL)) ++ PCL::PV-TABLE-CACHE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) + COMMON-LISP::T) +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| +- PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| + PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| +- WALKER::WALK-PROG/PROG* +- PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +- WALKER::WALK-BINDINGS-2 +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +- WALKER::WALK-DO/DO* +- PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- PCL::|(FAST-METHOD DOCUMENTATION (T))| ++ WALKER::WALK-TEMPLATE PCL::|(FAST-METHOD PRINT-OBJECT (T T))| ++ WALKER::WALK-DO/DO* PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR + PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| +- PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ WALKER::WALK-LET/LET* ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++ PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE ++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| + PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| +- PCL::INITIALIZE-INSTANCE-SIMPLE PCL::BOOTSTRAP-SET-SLOT +- PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +- PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| +- PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| +- PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| +- PCL::FILL-CACHE-P +- PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +- PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| ++ PCL::INITIALIZE-INSTANCE-SIMPLE ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| ++ PCL::EXPAND-SYMBOL-MACROLET-INTERNAL + PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +- PCL::OPTIMIZE-WRITER PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL +- PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| + PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1 +- PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| +- PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| + PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +- PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +- PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +- PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +- PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +- PCL::ADJUST-CACHE +- PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR +- PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| + PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +- PCL::MEMF-TEST-CONVERTER + PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +- WALKER::WALK-TEMPLATE PCL::TWO-CLASS-DFUN-INFO +- PCL::EXPAND-CACHE ++ PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| ++ PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| + PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++ PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++ PCL::MAKE-DISPATCH-LAMBDA ++ PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ PCL::EXPAND-DEFCLASS ++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ PCL::OPTIMIZE-WRITER ++ PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD DOCUMENTATION (T))| ++ PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| + PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| +- PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +- PCL::GET-WRAPPERS-FROM-CLASSES +- PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +- PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- PCL::LOAD-PRECOMPILED-IIS-ENTRY +- PCL::|(FAST-METHOD PRINT-OBJECT (T T))| +- PCL::EXPAND-SYMBOL-MACROLET-INTERNAL +- PCL::MAYBE-EXPAND-ACCESSOR-FORM ++ PCL::OPTIMIZE-READER WALKER::WALK-PROG/PROG* ++ PCL::BOOTSTRAP-SET-SLOT + PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY +- PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| +- PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ PCL::TWO-CLASS-DFUN-INFO ++ PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))| ++ PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ PCL::ADJUST-CACHE ++ PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ PCL::EXPAND-CACHE ++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| ++ PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))| ++ PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| ++ PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++ PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| ++ PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| + PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +- PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| +- PCL::EXPAND-DEFCLASS +- PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +- WALKER::WALK-LET/LET* PCL::MAKE-DISPATCH-LAMBDA ++ PCL::GET-WRAPPERS-FROM-CLASSES ++ PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++ PCL::MAYBE-EXPAND-ACCESSOR-FORM WALKER::WALK-BINDINGS-2 ++ PCL::FILL-CACHE-P PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL + PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +- PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| +- PCL::OPTIMIZE-READER +- PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +- PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))|)) ++ PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++ PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++ PCL::LOAD-PRECOMPILED-IIS-ENTRY PCL::MEMF-TEST-CONVERTER ++ PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::REAL-ADD-NAMED-METHOD PCL::EARLY-ADD-NAMED-METHOD ++ PCL::FILL-DFUN-CACHE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- PCL::OPTIMIZE-SET-SLOT-VALUE +- PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +- PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +- PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +- PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +- PCL::PRINT-CACHE WALKER::WALK-UNEXPECTED-DECLARE +- ITERATE::OPTIMIZE-ITERATE-FORM +- PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| +- WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::FIRST-FORM-TO-LISP +- PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| +- WALKER::WALK-LABELS +- PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +- PCL::ONE-CLASS-DFUN-INFO PCL::GET-FUNCTION-GENERATOR +- WALKER::RELIST-INTERNAL PCL::NOTE-PV-TABLE-REFERENCE +- WALKER::WALK-LAMBDA PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS +- PCL::ONE-INDEX-DFUN-INFO PCL::MAP-ALL-ORDERS +- PCL::OPTIMIZE-GF-CALL-INTERNAL PCL::COMPUTE-PRECEDENCE +- WALKER::WALK-DO PCL::PRINT-STD-INSTANCE +- PCL::OBSOLETE-INSTANCE-TRAP PCL::SORT-APPLICABLE-METHODS +- PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- PCL::EMIT-GREATER-THAN-1-DLAP +- PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- WALKER::WALK-FLET +- PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| +- PCL::|SETF PCL PLIST-VALUE| WALKER::WALK-PROG* +- WALKER::VARIABLE-DECLARATION +- PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| +- PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1 +- WALKER::WALK-MACROLET PCL::CAN-OPTIMIZE-ACCESS +- WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL +- PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +- PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +- PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +- PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P +- PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +- PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +- PCL::EMIT-BOUNDP-CHECK PCL::|SETF PCL METHOD-FUNCTION-GET| ++ PCL::OBSOLETE-INSTANCE-TRAP + PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| +- PCL::MAKE-METHOD-SPEC PCL::FLUSH-CACHE-TRAP WALKER::WALK-IF +- PCL::OPTIMIZE-SLOT-BOUNDP +- PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD +- WALKER::WALK-MULTIPLE-VALUE-BIND +- ITERATE::RENAME-AND-CAPTURE-VARIABLES WALKER::WALK-LET* +- WALKER::WALK-DO* +- PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +- PCL::INVALIDATE-WRAPPER +- PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++ WALKER::WALK-TAGBODY ++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ PCL::ENTRY-IN-CACHE-P WALKER::WALK-COMPILER-LET + PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +- PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION +- ITERATE::SIMPLE-EXPAND-GATHERING-FORM PCL::ENTRY-IN-CACHE-P +- WALKER::WALK-LOCALLY PCL::OPTIMIZE-SLOT-VALUE ++ PCL::NOTE-PV-TABLE-REFERENCE PCL::COMPUTE-EFFECTIVE-METHOD ++ PCL::MAKE-DFUN-CALL PCL::|SETF PCL PLIST-VALUE| ++ PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| ++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| ++ PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ WALKER::WALK-UNEXPECTED-DECLARE + PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL ++ PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1 ++ WALKER::WALK-DO PCL::EMIT-1-T-DLAP PCL::PRINT-STD-INSTANCE ++ PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++ WALKER::WALK-LAMBDA PCL::MAKE-METHOD-SPEC ++ PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| ++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| ++ PCL::OPTIMIZE-SET-SLOT-VALUE ++ PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::EXPAND-DEFGENERIC WALKER::VARIABLE-DECLARATION ++ ITERATE::RENAME-AND-CAPTURE-VARIABLES ++ PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++ PCL::MAP-ALL-ORDERS ++ PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| ++ PCL::DECLARE-STRUCTURE WALKER::WALK-PROG ++ PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++ PCL::OPTIMIZE-SLOT-VALUE WALKER::WALK-MULTIPLE-VALUE-BIND + PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| ++ PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD WALKER::WALK-LOCALLY ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| ++ WALKER::WALK-DO* + PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::EMIT-BOUNDP-CHECK WALKER::RECONS ++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| ++ PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| ++ WALKER::WALK-LET* WALKER::WALK-TAGBODY-1 PCL::FLUSH-CACHE-TRAP ++ WALKER::WALK-FLET ++ PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| ++ PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ PCL::PRINT-CACHE + PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +- PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +- PCL::TRACE-EMF-CALL-INTERNAL WALKER::WALK-SYMBOL-MACROLET +- PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| +- PCL::CONVERT-TABLE ++ PCL::INVALIDATE-WRAPPER PCL::GET-NEW-FUNCTION-GENERATOR ++ ITERATE::OPTIMIZE-ITERATE-FORM WALKER::RELIST-INTERNAL ++ PCL::CAN-OPTIMIZE-ACCESS PCL::MAKE-TOP-LEVEL-FORM + PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ WALKER::WALK-MULTIPLE-VALUE-SETQ WALKER::WALK-LABELS ++ PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++ PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| ++ PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| ++ WALKER::WALK-SETQ WALKER::WALK-LET ++ PCL::|SETF PCL METHOD-FUNCTION-GET| WALKER::WALK-IF ++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| ++ ITERATE::SIMPLE-EXPAND-GATHERING-FORM ++ PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++ WALKER::WALK-NAMED-LAMBDA PCL::FIRST-FORM-TO-LISP ++ PCL::ONE-CLASS-DFUN-INFO ++ WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL ++ PCL::EMIT-GREATER-THAN-1-DLAP PCL::CONVERT-TABLE ++ PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| + PCL::INITIALIZE-INTERNAL-SLOT-GFS* ++ ITERATE::OPTIMIZE-GATHERING-FORM ++ PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ PCL::OPTIMIZE-SLOT-BOUNDP ++ PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| ++ PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS ++ WALKER::WALK-SYMBOL-MACROLET ITERATE::VARIABLE-SAME-P ++ PCL::EMIT-SLOT-READ-FORM ++ PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P ++ PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ PCL::GET-FUNCTION-GENERATOR ++ PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++ PCL::FIX-SLOT-ACCESSORS + PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| +- PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))| +- PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +- PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION + PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| +- PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| +- PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +- WALKER::WALK-SETQ PCL::EXPAND-DEFGENERIC +- PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +- ITERATE::OPTIMIZE-GATHERING-FORM PCL::FIX-SLOT-ACCESSORS +- PCL::EMIT-SLOT-READ-FORM WALKER::WALK-PROG +- PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +- WALKER::WALK-NAMED-LAMBDA PCL::GET-NEW-FUNCTION-GENERATOR +- PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- WALKER::WALK-TAGBODY +- PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| +- WALKER::WALK-COMPILER-LET PCL::DECLARE-STRUCTURE +- WALKER::WALK-LET ITERATE::VARIABLE-SAME-P +- PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +- PCL::EMIT-1-T-DLAP PCL::MAKE-DFUN-CALL +- PCL::COMPUTE-EFFECTIVE-METHOD PCL::SORT-METHODS +- WALKER::WALK-TAGBODY-1 ++ PCL::OPTIMIZE-GF-CALL-INTERNAL ++ PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| + PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++ PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| + PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| +- PCL::MAKE-TOP-LEVEL-FORM +- PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +- WALKER::RECONS)) ++ PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ WALKER::WALK-PROG* PCL::ONE-INDEX-DFUN-INFO ++ PCL::COMPUTE-PRECEDENCE PCL::TRACE-EMF-CALL-INTERNAL ++ WALKER::WALK-MACROLET)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::MAKE-DEFMETHOD-FORM-INTERNAL PCL::LOAD-DEFMETHOD ++ PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM)) ++(COMMON-LISP::PROCLAIM ++ '(COMMON-LISP::FTYPE ++ (COMMON-LISP::FUNCTION ++ (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::T) ++ PCL::GET-EFFECTIVE-METHOD-FUNCTION1 ++ PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS ++ PCL::MAKE-EMF-FROM-METHOD ++ PCL::REAL-ENSURE-GF-USING-CLASS--NULL PCL::PROBE-CACHE ++ PCL::MAP-CACHE PCL::GET-DECLARATION ++ PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION ++ WALKER::CONVERT-MACRO-TO-LAMBDA ++ PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION PCL::EMIT-MISS ++ PCL::GET-METHOD-FUNCTION-PV-CELL PCL::METHOD-FUNCTION-GET ++ PCL::FIND-CLASS-FROM-CELL PCL::RECORD-DEFINITION ++ PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 ++ PCL::FIND-CLASS-PREDICATE-FROM-CELL ++ PCL::NAMED-OBJECT-PRINT-FUNCTION ++ PCL::PRECOMPUTE-EFFECTIVE-METHODS PCL::INITIALIZE-INFO ++ PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) +- PCL::UPDATE-SLOTS-IN-PV PCL::MAKE-INSTANCE-FUNCTION-COMPLEX +- PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++ PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 + PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL +- PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +- PCL::MAKE-INSTANCE-FUNCTION-SIMPLE +- PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +- PCL::COMPUTE-PV-SLOT PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1 +- PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| +- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| +- PCL::OPTIMIZE-INSTANCE-ACCESS +- PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 PCL::MAKE-EMF-CACHE ++ PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++ PCL::MAKE-FGEN + PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +- PCL::REAL-MAKE-METHOD-INITARGS-FORM ++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS ++ PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::OPTIMIZE-ACCESSOR-CALL ++ PCL::MAKE-INSTANCE-FUNCTION-COMPLEX PCL::UPDATE-SLOTS-IN-PV ++ PCL::COMPUTE-PV-SLOT + PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| ++ PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| + PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++ PCL::OPTIMIZE-INSTANCE-ACCESS ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ PCL::MAKE-INSTANCE-FUNCTION-SIMPLE ++ PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ PCL::OPTIMIZE-GENERIC-FUNCTION-CALL ++ PCL::LOAD-FUNCTION-GENERATOR WALKER::WALK-BINDINGS-1 + PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +- PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL +- PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS +- PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| ++ PCL::REAL-MAKE-METHOD-INITARGS-FORM ++ PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++ PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT + PCL::MAKE-PARAMETER-REFERENCES +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))| + PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| ++ PCL::EXPAND-EMF-CALL-METHOD ++ PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| ++ PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| + PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| + PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::OPTIMIZE-ACCESSOR-CALL +- WALKER::WALK-TEMPLATE-HANDLE-REPEAT WALKER::WALK-BINDINGS-1 + PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +- PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1 +- PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::MAKE-FGEN +- PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +- PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +- PCL::OPTIMIZE-GENERIC-FUNCTION-CALL +- PCL::LOAD-FUNCTION-GENERATOR PCL::MAKE-EMF-CACHE +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +- PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::EXPAND-EMF-CALL-METHOD)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::EXPAND-DEFMETHOD PCL::LOAD-DEFMETHOD-INTERNAL)) ++ PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::*) + COMMON-LISP::T) +- PCL::FILL-CACHE PCL::CAN-OPTIMIZE-ACCESS1 PCL::MAKE-EMF-CALL ++ PCL::GET-METHOD WALKER::WALK-ARGLIST PCL::REAL-GET-METHOD + PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-2-LIST +- PCL::GET-METHOD PCL::CHECK-INITARGS-2-PLIST +- PCL::CHECK-INITARGS-1 PCL::REAL-GET-METHOD +- WALKER::WALK-ARGLIST)) ++ PCL::FILL-CACHE PCL::CHECK-INITARGS-2-PLIST PCL::MAKE-EMF-CALL ++ PCL::CHECK-INITARGS-1 PCL::CAN-OPTIMIZE-ACCESS1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +@@ -605,394 +778,250 @@ + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::LOAD-DEFMETHOD PCL::MAKE-DEFMETHOD-FORM +- PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM-INTERNAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) + COMMON-LISP::T) ++ PCL::REAL-LOAD-DEFCLASS PCL::LOAD-DEFCLASS PCL::SET-ARG-INFO1 ++ PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION PCL::EMIT-SLOT-ACCESS ++ WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 PCL::OPTIMIZE-GF-CALL + PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::SET-ARG-INFO1 PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION +- PCL::LOAD-DEFCLASS PCL::REAL-LOAD-DEFCLASS +- PCL::OPTIMIZE-GF-CALL WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 +- PCL::EMIT-SLOT-ACCESS PCL::MAKE-EARLY-CLASS-DEFINITION)) ++ PCL::MAKE-EARLY-CLASS-DEFINITION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) ++ COMMON-LISP::FIXNUM) + COMMON-LISP::T) +- PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) ++ PCL::GET-CACHE PCL::FILL-CACHE-FROM-CACHE-P)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::EARLY-ADD-NAMED-METHOD PCL::FILL-DFUN-CACHE +- PCL::REAL-ADD-NAMED-METHOD)) ++ (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) ++ COMMON-LISP::FIXNUM) ++ PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::BOOTSTRAP-INITIALIZE-CLASS)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T) ++ PCL::EVAL-FORM PCL::EARLY-CLASS-NAME-OF PCL::DFUN-INFO-CACHE ++ PCL::MAKE-CONSTANT-FUNCTION PCL::EXPAND-SHORT-DEFCOMBIN ++ PCL::COPY-CACHE PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES ++ PCL::MAKE-INITIAL-DFUN PCL::ECD-METACLASS ++ PCL::EXTRACT-SPECIALIZER-NAMES PCL::GBOUNDP ++ PCL::GET-SETF-FUNCTION-NAME PCL::USE-CACHING-DFUN-P ++ PCL::INITIALIZE-INFO-CACHED-CONSTANTS ++ PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS COMMON-LISP::CLASS-OF ++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION ++ PCL::ARG-INFO-KEY/REST-P PCL::METHOD-CALL-CALL-METHOD-ARGS ++ PCL::FGEN-GENSYMS PCL::EARLY-CLASS-PRECEDENCE-LIST ++ PCL::EARLY-SLOT-DEFINITION-LOCATION ++ PCL::EXPAND-MAKE-INSTANCE-FORM PCL::INTERN-EQL-SPECIALIZER ++ PCL::METHOD-FUNCTION-METHOD PCL::FGEN-GENERATOR-LAMBDA ++ PCL::SLOT-READER-SYMBOL PCL::CACHING-P ++ PCL::EARLY-METHOD-QUALIFIERS ++ PCL::EARLY-COLLECT-DEFAULT-INITARGS PCL::KEYWORD-SPEC-NAME ++ PCL::ONE-INDEX-P PCL::COMPLICATED-INSTANCE-CREATION-METHOD ++ PCL::DFUN-ARG-SYMBOL PCL::N-N-CACHE ++ PCL::ONE-INDEX-DFUN-INFO-INDEX PCL::INITIAL-DISPATCH-CACHE ++ PCL::CPD-CLASS PCL::FAST-METHOD-CALL-ARG-INFO ++ PCL::MAKE-PV-TYPE-DECLARATION PCL::COMPUTE-STD-CPL-PHASE-2 ++ PCL::GET-BUILT-IN-CLASS-SYMBOL ++ PCL::INITIALIZE-INFO-CACHED-RI-VALID-P ++ PCL::UPDATE-GFS-OF-CLASS PCL::STRUCTURE-SVUC-METHOD ++ PCL::SLOT-BOUNDP-SYMBOL PCL::FGEN-SYSTEM ++ PCL::FIND-CYCLE-REASONS ITERATE::SEQUENCE-ACCESSOR ++ PCL::GF-INFO-C-A-M-EMF-STD-P PCL::STRUCTURE-TYPE-P ++ PCL::TWO-CLASS-CACHE PCL::METHOD-LL->GENERIC-FUNCTION-LL ++ PCL::ONE-CLASS-ACCESSOR-TYPE PCL::WRAPPER-FOR-STRUCTURE ++ PCL::ACCESSOR-DFUN-INFO-CACHE PCL::%SYMBOL-FUNCTION ++ PCL::STRUCTURE-TYPE PCL::NET-TEST-CONVERTER ++ PCL::CONSTANT-SYMBOL-P PCL::GMAKUNBOUND PCL::INITIAL-P ++ PCL::GF-DFUN-CACHE PCL::STRUCTURE-SLOTD-TYPE ++ PCL::%STD-INSTANCE-WRAPPER PCL::INITIALIZE-INFO-P ++ PCL::CACHING-DFUN-INFO ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::FAST-METHOD-CALL-P PCL::GF-DFUN-INFO ++ PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::ECD-CLASS-NAME ++ PCL::MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION ++ PCL::STD-INSTANCE-P PCL::EXTRACT-PARAMETERS ++ WALKER::GET-WALKER-TEMPLATE PCL::SYMBOL-PKG-NAME ++ PCL::CCLOSUREP PCL::LOOKUP-FGEN PCL::CPD-SUPERS ++ PCL::ARG-INFO-KEYWORDS PCL::DISPATCH-P ++ PCL::INITIALIZE-INFO-CACHED-NEW-KEYS ++ PCL::MAKE-CALLS-TYPE-DECLARATION PCL::INITIALIZE-INFO-WRAPPER ++ PCL::%FBOUNDP PCL::DEFAULT-STRUCTURE-INSTANCE-P ++ WALKER::ENV-WALK-FORM PCL::EARLY-CLASS-DEFINITION ++ PCL::SORT-CALLS PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME ++ PCL::DISPATCH-CACHE PCL::INITIALIZE-INFO-KEY ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION ++ PCL::ARG-INFO-METATYPES PCL::GF-LAMBDA-LIST ++ WALKER::ENV-LEXICAL-VARIABLES PCL::ACCESSOR-DFUN-INFO-P ++ PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::COMPUTE-LINE-SIZE ++ PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION ++ PCL::FORCE-CACHE-FLUSHES PCL::TWO-CLASS-P PCL::DFUN-INFO-P ++ PCL::MAP-SPECIALIZERS PCL::MAKE-PERMUTATION-VECTOR ++ WALKER::ENV-LOCK PCL::CPD-AFTER PCL::EARLY-CLASS-SLOTS ++ PCL::GET-PV-CELL-FOR-CLASS PCL::ARG-INFO-P ++ PCL::EXTRACT-REQUIRED-PARAMETERS ++ PCL::STRUCTURE-SLOTD-READER-FUNCTION PCL::COMPUTE-CLASS-SLOTS ++ PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS ++ PCL::TWO-CLASS-WRAPPER0 ++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::COMPILE-LAMBDA-UNCOMPILED PCL::EARLY-CLASS-NAME ++ PCL::SFUN-P PCL::EXTRACT-LAMBDA-LIST PCL::UNDEFMETHOD-1 ++ PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::WRAPPER-OF ++ PCL::ARG-INFO-LAMBDA-LIST PCL::LIST-DFUN ++ PCL::NEXT-WRAPPER-FIELD PCL::CHECK-WRAPPER-VALIDITY ++ PCL::STRUCTURE-SLOTD-NAME PCL::BUILT-IN-WRAPPER-OF ++ PCL::GET-MAKE-INSTANCE-FUNCTIONS ++ PCL::GENERIC-CLOBBERS-FUNCTION PCL::NO-METHODS-P ++ PCL::CONSTANT-VALUE-P WALKER::ENV-WALK-FUNCTION ++ PCL::INITIAL-CACHE PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD ++ PCL::MAKE-CLASS-EQ-PREDICATE ++ PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL ++ PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS ++ PCL::FUNCTION-PRETTY-ARGLIST ++ PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION ++ PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST PCL::TYPE-CLASS ++ PCL::CHECK-CACHE PCL::STANDARD-SVUC-METHOD ++ PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::GF-INFO-FAST-MF-P ++ PCL::STRUCTURE-SLOTD-WRITER-FUNCTION ++ PCL::BOOTSTRAP-CLASS-PREDICATES PCL::DEFAULT-METHOD-ONLY-CACHE ++ PCL::GET-CACHE-VECTOR PCL::SLOT-WRITER-SYMBOL ++ PCL::FGEN-GENERATOR PCL::DNET-METHODS-P ++ PCL::DEFAULT-STRUCTURE-TYPE ++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST ++ PCL::N-N-ACCESSOR-TYPE ++ PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST ++ WALKER::ENV-DECLARATIONS WALKER::VARIABLE-GLOBALLY-SPECIAL-P ++ PCL::ONE-INDEX-INDEX PCL::ONE-INDEX-DFUN-INFO-CACHE ++ PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::EARLY-CLASS-SLOTDS ++ PCL::CANONICAL-SLOT-NAME PCL::EARLY-COLLECT-CPL ++ PCL::RESET-CLASS-INITIALIZE-INFO-1 ++ PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::ONE-INDEX-CACHE ++ PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION ++ PCL::MAKE-TYPE-PREDICATE PCL::FREE-CACHE ++ ITERATE::VARIABLES-FROM-LET ++ PCL::EARLY-METHOD-STANDARD-ACCESSOR-P ++ PCL::DEFAULT-CONSTANT-CONVERTER PCL::CLASS-PREDICATE ++ PCL::CHECKING-CACHE PCL::ARG-INFO-PRECEDENCE ++ PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P ++ PCL::DEFAULT-METHOD-ONLY-P ++ PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P ++ PCL::STRUCTURE-SLOT-BOUNDP PCL::ONE-INDEX-ACCESSOR-TYPE ++ PCL::TWO-CLASS-ACCESSOR-TYPE ++ PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P PCL::METHOD-CALL-P ++ PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::CONSTANT-VALUE-DFUN-INFO ++ PCL::COMPILE-LAMBDA-DEFERRED PCL::SETFBOUNDP ++ PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P ++ PCL::PV-TABLEP PCL::STRUCTURE-OBJECT-P PCL::TWO-CLASS-INDEX ++ PCL::METHOD-FUNCTION-PV-TABLE PCL::ECD-OTHER-INITARGS ++ WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE ++ PCL::EARLY-GF-P PCL::STRUCTURE-SLOTD-INIT-FORM ++ PCL::FUNCALLABLE-INSTANCE-P PCL::CHECKING-FUNCTION ++ PCL::FUNCTION-RETURNING-NIL PCL::FUNCTION-RETURNING-T ++ PCL::UPDATE-C-A-M-GF-INFO PCL::COUNT-DFUN ++ PCL::UNPARSE-SPECIALIZERS PCL::CACHE-OWNER ++ PCL::EARLY-METHOD-CLASS ++ PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION ++ PCL::EARLY-SLOT-DEFINITION-NAME ++ PCL::GET-MAKE-INSTANCE-FUNCTION ++ PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME ++ PCL::ECD-SUPERCLASS-NAMES PCL::GFS-OF-TYPE PCL::SORT-SLOTS ++ PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS ++ PCL::COMPUTE-MCASE-PARAMETERS PCL::METHOD-FUNCTION-PLIST ++ PCL::ARG-INFO-NKEYS PCL::FINAL-ACCESSOR-DFUN-TYPE ++ PCL::EARLY-COLLECT-SLOTS PCL::EARLY-METHOD-LAMBDA-LIST ++ PCL::FAST-INSTANCE-BOUNDP-P PCL::GDEFINITION ++ PCL::%CCLOSURE-ENV SYSTEM::%COMPILED-FUNCTION-NAME ++ PCL::RESET-INITIALIZE-INFO PCL::ARG-INFO-NUMBER-OPTIONAL ++ PCL::RESET-CLASS-INITIALIZE-INFO ++ PCL::INITIALIZE-INFO-CACHED-VALID-P PCL::INTERNED-SYMBOL-P ++ PCL::EARLY-GF-NAME PCL::FGEN-TEST PCL::MAKE-INITFUNCTION ++ PCL::MAP-ALL-GENERIC-FUNCTIONS PCL::SHOW-DFUN-COSTS ++ PCL::CLASS-FROM-TYPE PCL::EXPAND-LONG-DEFCOMBIN ++ PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION ++ PCL::FREE-CACHE-VECTOR PCL::%STD-INSTANCE-SLOTS ++ PCL::ALLOCATE-CACHE-VECTOR PCL::ONE-CLASS-P ++ PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::SLOT-VECTOR-SYMBOL ++ PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION ++ PCL::ONE-CLASS-WRAPPER0 PCL::N-N-P ++ PCL::UPDATE-ALL-C-A-M-GF-INFO PCL::CHECKING-P ++ PCL::TWO-CLASS-WRAPPER1 PCL::PARSE-SPECIALIZERS ++ PCL::FORMAT-CYCLE-REASONS PCL::FLUSH-CACHE-VECTOR-INTERNAL ++ PCL::UNENCAPSULATED-FDEFINITION PCL::ONE-CLASS-INDEX ++ PCL::DEFAULT-CONSTANTP PCL::UPDATE-GF-INFO ++ PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE ++ PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST ++ PCL::MAKE-EQL-PREDICATE PCL::ARG-INFO-VALID-P ++ PCL::CACHING-CACHE PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION ++ PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL ++ PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION ++ PCL::MAKE-FUNCTION-INLINE PCL::STORE-FGEN ++ PCL::LIST-LARGE-CACHE PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P ++ PCL::ARG-INFO-APPLYP SYSTEM::%STRUCTURE-NAME ++ PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::ECD-SOURCE ++ PCL::EARLY-CLASS-DIRECT-SUBCLASSES ++ PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::DEFAULT-TEST-CONVERTER ++ PCL::MAKE-CALL-METHODS PCL::GET-BUILT-IN-WRAPPER-SYMBOL ++ PCL::GF-INFO-STATIC-C-A-M-EMF PCL::DEFAULT-STRUCTUREP ++ PCL::CONSTANT-VALUE-CACHE PCL::INITIAL-DISPATCH-P ++ PCL::ECD-CANONICAL-SLOTS PCL::WRAPPER-FIELD ++ PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE PCL::ONE-CLASS-CACHE ++ PCL::CACHING-DFUN-COST PCL::LEGAL-CLASS-NAME-P ++ PCL::INTERN-FUNCTION-NAME PCL::FAST-METHOD-CALL-PV-CELL ++ PCL::CACHE-P PCL::ONE-INDEX-DFUN-INFO-P ++ PCL::MAKE-PV-TABLE-TYPE-DECLARATION PCL::NO-METHODS-CACHE)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM) +- COMMON-LISP::T) +- PCL::COMPUTE-STD-CPL-PHASE-3)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*) ++ PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD ++ COMMON-LISP::METHOD-COMBINATION-ERROR ++ COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::FIXNUM) ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) + COMMON-LISP::T) +- PCL::FILL-CACHE-FROM-CACHE-P PCL::GET-CACHE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) +- PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW +- PCL::PV-TABLE-SLOT-NAME-LISTS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- PCL::COMPUTE-CACHE-PARAMETERS)) ++ PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION +- (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- PCL::FIND-FREE-CACHE-LINE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN) +- PCL::CACHE-VALUEP)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*) +- PCL::DEFAULT-CODE-CONVERTER PCL::EMIT-IN-CHECKING-CACHE-P +- PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-TWO-CLASS-WRITER +- PCL::PARSE-METHOD-GROUP-SPECIFIER PCL::EMIT-ONE-CLASS-WRITER +- PCL::EMIT-ONE-INDEX-WRITERS PCL::FIND-STRUCTURE-CLASS +- PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA PCL::MAKE-DISPATCH-DFUN +- PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EARLY-METHOD-FUNCTION +- PCL::NET-CODE-CONVERTER PCL::GET-DISPATCH-FUNCTION +- PCL::STRUCTURE-WRAPPER PCL::FIND-WRAPPER PCL::CLASS-EQ-TYPE +- PCL::TYPE-FROM-SPECIALIZER PCL::SPECIALIZER-FROM-TYPE +- PCL::PCL-DESCRIBE PCL::PARSE-DEFMETHOD +- PCL::ANALYZE-LAMBDA-LIST PCL::EMIT-ONE-CLASS-READER +- PCL::EARLY-COLLECT-INHERITANCE PCL::GET-GENERIC-FUNCTION-INFO +- PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE +- PCL::EMIT-ONE-INDEX-READERS PCL::GENERIC-FUNCTION-NAME-P +- PCL::CONVERT-TO-SYSTEM-TYPE PCL::MAKE-FINAL-DISPATCH-DFUN +- PCL::EMIT-TWO-CLASS-READER PCL::*NORMALIZE-TYPE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T) +- PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION| +- PCL::MAKE-FAST-INSTANCE-BOUNDP PCL::MAKE-INITIALIZE-INFO +- PCL::|STRUCTURE-OBJECT class constructor| +- PCL::|__si::MAKE-CACHE| PCL::|__si::MAKE-DEFAULT-METHOD-ONLY| +- PCL::TRUE PCL::|__si::MAKE-PV-TABLE| +- PCL::|__si::MAKE-ONE-INDEX| WALKER::UNBOUND-LEXICAL-FUNCTION +- PCL::|__si::MAKE-CHECKING| PCL::MAKE-PV-TABLE +- PCL::|__si::MAKE-NO-METHODS| PCL::MAKE-METHOD-CALL +- PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL +- PCL::INTERN-PV-TABLE PCL::|__si::MAKE-ACCESSOR-DFUN-INFO| +- PCL::|__si::MAKE-DISPATCH| +- PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO| +- PCL::|__si::MAKE-ARG-INFO| PCL::FIX-EARLY-GENERIC-FUNCTIONS +- PCL::ZERO PCL::MAKE-PROGN PCL::|__si::MAKE-INITIAL| +- PCL::|__si::MAKE-ONE-CLASS| PCL::|__si::MAKE-DFUN-INFO| +- PCL::|__si::MAKE-CONSTANT-VALUE| +- PCL::|__si::MAKE-STD-INSTANCE| PCL::PV-WRAPPERS-FROM-PV-ARGS +- PCL::|__si::MAKE-TWO-CLASS| PCL::|__si::MAKE-N-N| +- PCL::|__si::MAKE-CACHING| PCL::FALSE PCL::STRING-APPEND +- PCL::|__si::MAKE-INITIAL-DISPATCH| PCL::MAKE-FAST-METHOD-CALL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM) +- PCL::ARG-INFO-NUMBER-REQUIRED PCL::PV-TABLE-PV-SIZE +- PCL::CACHE-COUNT PCL::PV-CACHE-LIMIT-FN PCL::CHECKING-LIMIT-FN +- PCL::CACHING-LIMIT-FN PCL::N-N-ACCESSORS-LIMIT-FN +- PCL::DEFAULT-LIMIT-FN PCL::EARLY-CLASS-SIZE PCL::CPD-COUNT +- PCL::ONE-INDEX-LIMIT-FN PCL::FAST-INSTANCE-BOUNDP-INDEX)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T) +- PCL::POWER-OF-TWO-CEILING)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*) ++ (COMMON-LISP::T COMMON-LISP::T ++ (COMMON-LISP::INTEGER -9223372036854775808 ++ 9223372036854775807)) + COMMON-LISP::T) +- PCL::MAKE-TYPE-PREDICATE-NAME PCL::MAKE-FINAL-DFUN +- PCL::CAPITALIZE-WORDS PCL::SET-DFUN ITERATE::MAYBE-WARN +- PCL::MAKE-EARLY-GF PCL::USE-DISPATCH-DFUN-P WALKER::RELIST +- PCL::MAKE-SPECIALIZABLE PCL::PV-TABLE-LOOKUP-PV-ARGS +- PCL::ALLOCATE-STANDARD-INSTANCE +- PCL::ALLOCATE-FUNCALLABLE-INSTANCE +- PCL::USE-CONSTANT-VALUE-DFUN-P ITERATE::FUNCTION-LAMBDA-P +- PCL::UPDATE-DFUN PCL::SET-ARG-INFO +- PCL::EARLY-METHOD-SPECIALIZERS PCL::MAKE-WRAPPER +- PCL::FIND-CLASS-CELL WALKER::WALKER-ENVIRONMENT-BIND-1 +- PCL::TRACE-METHOD WALKER::RELIST* COMMON-LISP::FIND-CLASS +- PCL::INITIALIZE-INTERNAL-SLOT-GFS PCL::FIND-CLASS-PREDICATE +- PCL::INITIALIZE-METHOD-FUNCTION)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- PCL::SAUT-NOT PCL::INVOKE-EMF PCL::SAUT-PROTOTYPE +- PCL::COMPUTE-CODE ITERATE::PARSE-DECLARATIONS +- PCL::SDFUN-FOR-CACHING +- PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES +- PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL +- PCL::SLOT-NAME-LISTS-FROM-SLOTS PCL::DESTRUCTURE +- PCL::SPLIT-DECLARATIONS PCL::MAKE-DIRECT-SLOTD +- PCL::FORM-LIST-TO-LISP PCL::EMIT-CHECKING +- PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::COMPUTE-TEST +- PCL::SET-FUNCTION-NAME COMMON-LISP::SLOT-BOUNDP PCL::SAUT-AND +- PCL::EMIT-CACHING PCL::INITIAL-DFUN +- COMMON-LISP::SLOT-MAKUNBOUND COMMON-LISP::SLOT-VALUE +- PCL::UPDATE-SLOT-VALUE-GF-INFO +- PCL::CLASS-APPLICABLE-USING-CLASS-P +- PCL::CPL-INCONSISTENT-ERROR PCL::*SUBTYPEP +- PCL::SLOT-UNBOUND-INTERNAL +- PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P +- PCL::CHECK-INITARGS-VALUES PCL::ENSURE-CLASS-VALUES +- PCL::SAUT-EQL PCL::REAL-REMOVE-METHOD PCL::EMIT-DEFAULT-ONLY +- PCL::INSURE-DFUN PCL::EMIT-DEFAULT-ONLY-FUNCTION +- PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN +- PCL::SAUT-CLASS PCL::MAKE-INSTANCE-FUNCTION-TRAP +- PCL::SAUT-CLASS-EQ PCL::COMPUTE-STD-CPL-PHASE-1 +- PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::T) +- (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL)) +- PCL::PV-TABLE-CACHE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::*) +- WALKER::WALK-DECLARATIONS PCL::GET-SECONDARY-DISPATCH-FUNCTION +- PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN)) ++ PCL::COMPUTE-STD-CPL-PHASE-3)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T ++ COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T) +- COMMON-LISP::*) +- PCL::MAKE-SHARED-INITIALIZE-FORM-LIST PCL::ACCESSOR-MISS +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +- PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +- PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +- PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))| +- PCL::SET-CLASS-SLOT-VALUE-1 +- PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +- PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| +- PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION +- PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN +- PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +- PCL::EMIT-CHECKING-OR-CACHING-FUNCTION +- PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN +- PCL::LOAD-SHORT-DEFCOMBIN PCL::EMIT-CHECKING-OR-CACHING +- PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))| +- PCL::MAKE-FINAL-CHECKING-DFUN +- PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| +- PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +- PCL::ACCESSOR-VALUES +- PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| +- PCL::REAL-MAKE-METHOD-LAMBDA +- PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))| +- PCL::GET-ACCESSOR-METHOD-FUNCTION +- PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +- PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| +- PCL::ORDER-SPECIALIZERS +- PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +- PCL::GENERATE-DISCRIMINATION-NET +- PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| +- PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +- PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN +- PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))| +- PCL::BOOTSTRAP-ACCESSOR-DEFINITION +- PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION +- PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION +- PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +- PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +- PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION +- PCL::CONVERT-METHODS WALKER::WALK-LET-IF +- PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES-INTERNAL +- PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +- PCL::LOAD-LONG-DEFCOMBIN PCL::CHECK-METHOD-ARG-INFO +- PCL::ACCESSOR-VALUES1 +- PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +- PCL::GENERATING-LISP PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN +- WALKER::WALK-FORM-INTERNAL PCL::CONSTANT-VALUE-MISS +- PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS +- PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| +- PCL::SLOT-BOUNDP-USING-CLASS-DFUN PCL::CHECKING-MISS +- PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| +- PCL::EMIT-READER/WRITER ITERATE::EXPAND-INTO-LET +- PCL::GET-CLASS-SLOT-VALUE-1 +- PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION +- PCL::MAKE-FINAL-CACHING-DFUN +- PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +- PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +- PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION +- PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +- PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P PCL::SET-SLOT-VALUE +- PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER +- ITERATE::RENAME-VARIABLES +- PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| +- PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| +- ITERATE::WALK-GATHERING-BODY PCL::CACHE-MISS-VALUES +- PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION +- PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER +- PCL::GENERATE-DISCRIMINATION-NET-INTERNAL +- PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION +- PCL::CACHE-MISS-VALUES-INTERNAL)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::T) +- COMMON-LISP::*) +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| +- PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| +- PCL::ADD-METHOD-DECLARATIONS +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +- PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +- PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL +- PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +- PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +- PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN +- PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +- PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +- PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +- PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| +- PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +- PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- PCL::WALK-METHOD-LAMBDA +- PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|)) ++ COMMON-LISP::T) ++ PCL::EXPAND-DEFMETHOD PCL::LOAD-DEFMETHOD-INTERNAL)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE + (COMMON-LISP::FUNCTION + (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::*) +- COMMON-LISP::*) +- PCL::REAL-MAKE-A-METHOD)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- PCL::MAKE-DEFAULT-INITARGS-FORM-LIST +- PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS +- PCL::SLOT-VALUE-OR-DEFAULT +- PCL::GET-SIMPLE-INITIALIZATION-FUNCTION PCL::REAL-ADD-METHOD +- PCL::LOAD-DEFGENERIC PCL::CPL-ERROR +- PCL::MAKE-FINAL-ACCESSOR-DFUN PCL::MAKE-N-N-ACCESSOR-DFUN +- PCL::TYPES-FROM-ARGUMENTS PCL::MAKE-ACCESSOR-TABLE +- PCL::MAKE-CHECKING-DFUN WALKER::NESTED-WALK-FORM +- PCL::GET-EFFECTIVE-METHOD-FUNCTION +- PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T + COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T) +- COMMON-LISP::*) +- ITERATE::ITERATE-TRANSFORM-BODY +- PCL::|(FAST-METHOD SLOT-MISSING (T T T T))| +- PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T +- COMMON-LISP::T COMMON-LISP::*) +- COMMON-LISP::*) +- PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1 +- ITERATE::RENAME-LET-BINDINGS)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM COMMON-LISP::T) +- COMMON-LISP::FIXNUM) +- PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*) +- COMMON-LISP::T) +- PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION +- PCL::GET-CACHE-FROM-CACHE)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T) +- COMMON-LISP::T) +- PCL::%CCLOSURE-ENV-NTHCDR)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION +- (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T) ++ COMMON-LISP::*) + COMMON-LISP::T) +- PCL::PRINT-DFUN-INFO)) +-(COMMON-LISP::PROCLAIM +- '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*) +- PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-WRITERS +- PCL::EMIT-N-N-READERS)) ++ PCL::BOOTSTRAP-INITIALIZE-CLASS)) + (COMMON-LISP::PROCLAIM + '(COMMON-LISP::FTYPE +- (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM) +- PCL::GET-WRAPPER-CACHE-NUMBER)) ++ (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST) ++ PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW ++ PCL::PV-TABLE-SLOT-NAME-LISTS)) + (IN-PACKAGE "PCL") + +-(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| +- |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| ++(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)| + |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)| + |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)| + |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)| + |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)| +@@ -1034,17 +1063,16 @@ + COMPATIBLE-META-CLASS-CHANGE-P + |(FAST-READER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)| + |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)| +- |(BOUNDP READER-FUNCTION)| TRACE-METHOD-INTERNAL +- |(BOUNDP PREDICATE-NAME)| |(BOUNDP READERS)| +- UPDATE-GF-DFUN |(BOUNDP CLASS-PRECEDENCE-LIST)| ++ |(BOUNDP READER-FUNCTION)| |(BOUNDP PREDICATE-NAME)| ++ |(BOUNDP READERS)| UPDATE-GF-DFUN ++ |(BOUNDP CLASS-PRECEDENCE-LIST)| + |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)| + |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT + |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)| + ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)| + |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| +- REDEFINE-FUNCTION SPECIALIZER-CLASS +- |(BOUNDP PRETTY-ARGLIST)| ++ SPECIALIZER-CLASS |(BOUNDP PRETTY-ARGLIST)| + |PCL::PCL-CLASS class predicate| + |PCL::STD-CLASS class predicate| + |(BOUNDP DEFSTRUCT-FORM)| +@@ -1082,104 +1110,104 @@ + |(BOUNDP OPTIONS)| |(WRITER METHOD)| + |PCL::DEPENDENT-UPDATE-MIXIN class predicate| + GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)| ++ |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| + |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))| + |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))| +- |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| + |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))| + |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))| +- |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))| +- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| +- |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| + |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))| +- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| + |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))| + |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))| ++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))| ++ |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))| + MAKE-BOUNDP-METHOD-FUNCTION + |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))| + |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))| + |PCL::METAOBJECT class predicate| +- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| ++ |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| ++ |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| ++ |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| ++ |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| + |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| ++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))| ++ |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| + |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))| +- |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| +- |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))| + |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))| +- |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))| +- |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| ++ |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| ++ |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| + |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| + |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))| +- |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| ++ |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))| + |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))| +- |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))| +- |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))| +- |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))| +- |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))| +- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))| +- |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))| +- |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))| +- |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))| +- |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))| +- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))| +- |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD CHANGE-CLASS (T SYMBOL))| + |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))| ++ |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD MAKE-INSTANCE (SYMBOL))| ++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| + |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| +- |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| +- |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| +- |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| +- |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| +- |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| +- |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| +- |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))| ++ |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| ++ |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| ++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| + |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| ++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))| ++ |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| + |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))| +- |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| + |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))| +- |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| ++ |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| + |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))| +- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| +- |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| +- |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| +- |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))| + |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))| +- |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))| +- |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| +- |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD SPECIALIZER-CLASS (CLASS))| +- |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| +- |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))| +- |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))| ++ |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))| ++ |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))| +- |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))| +- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))| +- |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))| +- |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))| +- |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| +- |(FAST-METHOD MAKE-INSTANCE (CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))| +- |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| +- |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))| +- |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++ |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))| ++ |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| + |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))| ++ |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))| ++ |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))| ++ |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))| ++ |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))| ++ |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))| ++ |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))| ++ |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))| + |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))| + |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))| ++ |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))| ++ |(FAST-METHOD MAKE-INSTANCE (CLASS))| + |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))| +- |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))| ++ |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))| ++ |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))| ++ |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| ++ |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))| + CLASS-PREDICATE-NAME + |PCL::STRUCTURE-SLOT-DEFINITION class predicate| + |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate| +@@ -1205,8 +1233,8 @@ + |(WRITER PREDICATE-NAME)| |(WRITER READERS)| + |(READER WRITER-FUNCTION)| |(READER INITFUNCTION)| + INITIALIZE-INTERNAL-SLOT-FUNCTIONS +- |SETF PCL SLOT-DEFINITION-TYPE| |(READER WRITERS)| +- |(WRITER CLASS-PRECEDENCE-LIST)| ++ |SETF PCL SLOT-DEFINITION-TYPE| ++ |(WRITER CLASS-PRECEDENCE-LIST)| |(READER WRITERS)| + |(WRITER ACCESSOR-FLAGS)| |(READER INITFORM)| + METHOD-COMBINATION-P |(WRITER LOCATION)| + |(WRITER DOCUMENTATION)| +@@ -1220,11 +1248,11 @@ + |(READER ALLOCATION)| |(WRITER SPECIALIZERS)| + |(CALL REAL-ENSURE-GF-USING-CLASS--NULL)| + |(WRITER IDENTITY-WITH-ONE-ARGUMENT)| +- |(SETF METHOD-GENERIC-FUNCTION)| +- |(WRITER PRETTY-ARGLIST)| LEGAL-SPECIALIZERS-P +- |SETF PCL OBJECT-PLIST| |(WRITER DEFSTRUCT-FORM)| +- |(READER FUNCTION)| |(READER GENERIC-FUNCTION)| +- |(READER LAMBDA-LIST)| |(READER SLOT-DEFINITION)| ++ |(SETF METHOD-GENERIC-FUNCTION)| LEGAL-SPECIALIZERS-P ++ |(WRITER PRETTY-ARGLIST)| |SETF PCL OBJECT-PLIST| ++ |(WRITER DEFSTRUCT-FORM)| |(READER FUNCTION)| ++ |(READER GENERIC-FUNCTION)| |(READER LAMBDA-LIST)| ++ |(READER SLOT-DEFINITION)| + |PCL::CLASS-PROTOTYPE-SPECIALIZER class predicate| + |SETF PCL SLOT-DEFINITION-INITFORM| + |SETF PCL CLASS-DEFSTRUCT-FORM| +@@ -1245,16 +1273,17 @@ + |SETF PCL SLOT-DEFINITION-ALLOCATION| + |SETF PCL SLOT-DEFINITION-INITFUNCTION| + |(WRITER SLOT-NAME)| |(BOUNDP NAME)| +- |(READER FAST-FUNCTION)| |(WRITER ALLOCATION)| ++ |(WRITER ALLOCATION)| |(READER FAST-FUNCTION)| + |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)| + |(READER INTERNAL-WRITER-FUNCTION)| + |(READER INTERNAL-READER-FUNCTION)| + |(READER METHOD-COMBINATION)| + METHOD-COMBINATION-OPTIONS |(READER DIRECT-SLOTS)| + |(READER DIRECT-METHODS)| +- |SETF PCL SLOT-DEFINITION-READERS| |(WRITER FUNCTION)| +- |(WRITER GENERIC-FUNCTION)| |(READER BOUNDP-FUNCTION)| +- |SETF PCL DOCUMENTATION| |(READER DIRECT-SUBCLASSES)| ++ |SETF PCL SLOT-DEFINITION-READERS| ++ |(READER BOUNDP-FUNCTION)| |(WRITER FUNCTION)| ++ |(WRITER GENERIC-FUNCTION)| |SETF PCL DOCUMENTATION| ++ |(READER DIRECT-SUBCLASSES)| + |(READER DIRECT-SUPERCLASSES)| |(WRITER LAMBDA-LIST)| + FUNCALLABLE-STANDARD-CLASS-P + |(FAST-WRITER-METHOD SLOT-OBJECT METHOD)| +@@ -1265,7 +1294,7 @@ + |SETF PCL SLOT-VALUE-USING-CLASS| + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)| + |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)| +- |(WRITER PROTOTYPE)| |(BOUNDP TYPE)| |(BOUNDP OBJECT)| ++ |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)| + CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS| + |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION + |(BOUNDP PLIST)| +@@ -1280,11 +1309,11 @@ + |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)| + |PCL::PLIST-MIXIN class predicate| + |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)| +- |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| GET-METHOD ++ |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| + |(WRITER INTERNAL-WRITER-FUNCTION)| + |(WRITER INTERNAL-READER-FUNCTION)| +- |(WRITER METHOD-COMBINATION)| |(WRITER DIRECT-SLOTS)| +- |(WRITER DIRECT-METHODS)| ++ |(WRITER METHOD-COMBINATION)| GET-METHOD ++ |(WRITER DIRECT-SLOTS)| |(WRITER DIRECT-METHODS)| + |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)| + |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)| +@@ -1354,18 +1383,18 @@ + |(FAST-READER-METHOD SLOT-DEFINITION READERS)| + |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)| ++ |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| ++ |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-READER-METHOD SPECIALIZER TYPE)| + |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)| + |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)| +- |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| +- |(FAST-READER-METHOD SLOT-OBJECT TYPE)| +- |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| +- |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)| +- |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)| + |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)| + |(FAST-READER-METHOD SLOT-OBJECT OBJECT)| + |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)| ++ |(FAST-READER-METHOD SLOT-DEFINITION TYPE)| ++ |(FAST-READER-METHOD SLOT-OBJECT TYPE)| ++ |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)| + |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| + |(FAST-READER-METHOD SLOT-OBJECT INITFORM)| +@@ -1387,11 +1416,11 @@ + |(FAST-READER-METHOD SLOT-CLASS SLOTS)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)| + |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)| ++ |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-READER-METHOD SLOT-OBJECT METHODS)| + |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)| + |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)| +- |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| + |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)| + |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)| +@@ -1429,8 +1458,8 @@ + |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)| + |(SETF SLOT-VALUE-USING-CLASS)| +@@ -1456,10 +1485,10 @@ + |(SETF SLOT-DEFINITION-TYPE)| + |(SETF SLOT-DEFINITION-INITFORM)| + |(BOUNDP INITIALIZE-INFO)| +- |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)| ++ |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)| + |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)| +@@ -1468,94 +1497,95 @@ + |(BOUNDP INITARGS)| LONG-METHOD-COMBINATION-FUNCTION + GENERIC-FUNCTION-P + |PCL::SLOT-DEFINITION class predicate| |(READER NAME)| +- |(READER CLASS)| |(FAST-METHOD SLOT-UNBOUND (T T T))| +- |(FAST-METHOD (SETF DOCUMENTATION) (T T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| +- |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| +- |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| +- |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ |(READER CLASS)| ++ |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| ++ |(FAST-METHOD DESCRIBE-OBJECT (T T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| ++ |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| ++ |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| ++ |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| + |(FAST-METHOD REMOVE-NAMED-METHOD (T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| ++ |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| +- |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))| + |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))| +- |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| +- |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| + |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))| +- |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| ++ |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| ++ |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| ++ |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| ++ |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| + |(FAST-METHOD PRINT-OBJECT (CLASS T))| +- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))| + |(FAST-METHOD PRINT-OBJECT (T T))| +- |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))| +- |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))| ++ |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| ++ |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| + |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))| + |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| +- |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))| +- |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| +- |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| +- |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| +- |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))| +- |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))| +- |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))| ++ |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))| ++ |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))| + |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))| +- |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))| + |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))| +- |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))| + |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))| +- |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))| ++ |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| + |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| +- |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))| + |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))| +- |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++ |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))| ++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| ++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))| ++ |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| + |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))| ++ |(FAST-METHOD (SETF DOCUMENTATION) (T T))| ++ |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))| ++ |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))| ++ |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| + |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))| +- |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))| +- |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))| +- |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))| +- |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))| +- |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))| ++ |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| + |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))| +- |(FAST-METHOD DESCRIBE-OBJECT (T T))| +- |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| +- |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))| +- |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))| +- |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))| +- |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))| +- |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))| ++ |(FAST-METHOD SLOT-UNBOUND (T T T))| + |(FAST-METHOD SLOT-MISSING (T T T T))| +- |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))| +- LEGAL-SLOT-NAME-P |(READER TYPE)| |(READER OBJECT)| ++ |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))| ++ |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))| ++ LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)| + CLASS-WRAPPER |(READER PLIST)| + |(FAST-METHOD CLASS-PREDICATE-NAME (T))| + |(FAST-METHOD DOCUMENTATION (T))| + |(FAST-METHOD NO-APPLICABLE-METHOD (T))| + |(READER SLOTS)| |(WRITER NAME)| DEFINITION-SOURCE + |PCL::SLOT-OBJECT class predicate| DEFAULT-INITARGS +- |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER TYPE)| +- |(WRITER OBJECT)| ++ |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER OBJECT)| ++ |(WRITER TYPE)| + |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))| + |(WRITER PLIST)| |(WRITER SLOTS)| + |PCL::DOCUMENTATION-MIXIN class predicate| +@@ -1595,10 +1625,10 @@ + |COMMON-LISP::STANDARD-OBJECT class predicate| + |COMMON-LISP::BUILT-IN-CLASS class predicate| + |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-SLOTS)| +- |(SETF CLASS-DIRECT-SLOTS)| DO-STANDARD-DEFSETF-1 +- |(READER OPERATOR)| |(CALL REAL-GET-METHOD)| +- |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-ADD-METHOD)| +- |(READER ARG-INFO)| METHOD-COMBINATION-TYPE ++ |(SETF CLASS-DIRECT-SLOTS)| |(READER OPERATOR)| ++ |(CALL REAL-GET-METHOD)| |(CALL REAL-REMOVE-METHOD)| ++ |(CALL REAL-ADD-METHOD)| |(READER ARG-INFO)| ++ METHOD-COMBINATION-TYPE + |(READER DEFSTRUCT-CONSTRUCTOR)| + |(INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)| + |(READER INITIALIZE-INFO)| |(WRITER WRAPPER)| +@@ -1607,8 +1637,8 @@ + |(WRITER DEFSTRUCT-ACCESSOR-SYMBOL)| + COMPUTE-SLOT-ACCESSOR-INFO |(READER INITARGS)| + |(WRITER CLASS-EQ-SPECIALIZER)| +- STANDARD-BOUNDP-METHOD-P FDEFINE-CAREFULLY +- |(SETF DOCUMENTATION)| RAW-INSTANCE-ALLOCATOR ++ STANDARD-BOUNDP-METHOD-P |(SETF DOCUMENTATION)| ++ RAW-INSTANCE-ALLOCATOR + |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL| + |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)| + |(WRITER ARG-INFO)| +@@ -1621,8 +1651,9 @@ + METHOD-COMBINATION-DOCUMENTATION + |SETF PCL SLOT-DEFINITION-INITARGS| + REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD ++ |(WRITER INITARGS)| + |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR| +- |(WRITER INITARGS)| |(BOUNDP METHOD)| ++ |(BOUNDP METHOD)| + |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)| + |(FAST-WRITER-METHOD CLASS NAME)| + |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)| +@@ -1668,11 +1699,11 @@ + |(FAST-WRITER-METHOD SLOT-OBJECT READERS)| + |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)| + |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| + |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)| ++ |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| + |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)| + |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)| +- |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)| +- |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)| + REMOVE-NAMED-METHOD + |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)| + |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)| +@@ -1725,6 +1756,5 @@ + ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD + SLOT-DEFINITION-WRITERS + COMPUTE-APPLICABLE-METHODS-USING-CLASSES +- CLASS-PRECEDENCE-LIST DISASSEMBLE DESCRIBE-OBJECT +- COMPILE)) +- (SETF (GET V 'SYSTEM::PROCLAIMED-CLOSURE) T)) ++ CLASS-PRECEDENCE-LIST DESCRIBE-OBJECT)) ++ (SETF (GET V 'COMPILER::PROCLAIMED-CLOSURE) T)) diff --git a/patches/real_list_order.12 b/patches/real_list_order.12 new file mode 100644 index 00000000..9da00c36 --- /dev/null +++ b/patches/real_list_order.12 @@ -0,0 +1,159 @@ +Description: + TODO: Put a short summary on the line above and replace this paragraph + with a longer explanation of this change. Complete the meta-information + with other relevant fields (see below for details). To make it easier, the + information below has been extracted from the changelog. Adjust it or drop + it. + . + gcl (2.6.12-56) unstable; urgency=medium + . + * list_order.12 +Author: Camm Maguire + +--- +The information above should follow the Patch Tagging Guidelines, please +checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: , +Bug: +Bug-Debian: https://bugs.debian.org/ +Bug-Ubuntu: https://launchpad.net/bugs/ +Forwarded: +Reviewed-By: +Last-Update: 2017-08-25 + +--- gcl-2.6.12.orig/o/print.d ++++ gcl-2.6.12/o/print.d +@@ -702,18 +702,18 @@ print_symbol_name_body(object x) { + #define FOUND -1 + + static int +-write_sharp_eq(object *vp,bool dot) { ++do_write_sharp_eq(object x,bool dot) { + +- bool defined=vp[1]!=Cnil; ++ bool defined=x->c.c_cdr!=Cnil; + + if (dot) { + write_str(" . "); + if (!defined) return FOUND; + } + +- vp[1]=Ct; ++ x->c.c_cdr=Ct; + write_ch('#'); +- write_decimal((vp-PRINTvs_top)/2); ++ write_decimal(fix(x->c.c_car)); + write_ch(defined ? '#' : '='); + + return defined ? DONE : FOUND; +@@ -721,15 +721,12 @@ write_sharp_eq(object *vp,bool dot) { + } + + static int +-write_sharp_eqs(object x,bool dot) { ++write_sharp_eq(object x,bool dot) { + +- object *vp; ++ struct htent *e; + +- for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) +- if (x == *vp) +- return write_sharp_eq(vp,dot); +- +- return 0; ++ return PRINTvs_top[0]!=Cnil && (e=gethash(x,PRINTvs_top[0]))->hte_key!=OBJNULL ? ++ do_write_sharp_eq(e->hte_value,dot) : 0; + + } + +@@ -916,7 +913,7 @@ int level; + if (PRINTescape) { + if (x->s.s_hpack == Cnil) { + if (PRINTcircle) +- if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTgensym) + write_str("#:"); + } else if (x->s.s_hpack == keyword_package) { +@@ -952,7 +949,7 @@ int level; + break; + } + if (PRINTcircle) +- if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1028,7 +1025,7 @@ int level; + break; + } + if (PRINTcircle) +- if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1099,7 +1096,7 @@ int level; + break; + } + if (PRINTcircle) +- if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTpretty) { + if (x->c.c_car == sLquote && + type_of(x->c.c_cdr) == t_cons && +@@ -1146,7 +1143,7 @@ int level; + break; + } + if (PRINTcircle) +- switch (write_sharp_eqs(x,TRUE)) { ++ switch (write_sharp_eq(x,TRUE)) { + case FOUND: + write_object(x, level); + case DONE: +@@ -1316,7 +1313,7 @@ int level; + + case t_structure: + if (PRINTcircle) +- if (write_sharp_eqs(x,FALSE)==DONE) return; ++ if (write_sharp_eq(x,FALSE)==DONE) return; + if (PRINTlevel >= 0 && level >= PRINTlevel) { + write_ch('#'); + break; +@@ -1415,7 +1412,6 @@ travel_push(object x) { + + if (!travel_pushed(x)) { + vs_check_push(x); +- vs_check_push(Cnil); + travel_pushed(x)=1; + } + +@@ -1519,10 +1515,13 @@ travel_clear(object x) { + + } + ++object sLeq; + + static void + setupPRINTcircle(object x,int dogensyms) { + ++ object *xp; ++ + BEGIN_NO_INTERRUPT; + dgs=dogensyms; + travel_push(x); +@@ -1531,6 +1530,12 @@ setupPRINTcircle(object x,int dogensyms) + travel_clear(x); + END_NO_INTERRUPT; + ++ vs_check_push(PRINTvs_limit>PRINTvs_top ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil); ++ for (xp=PRINTvs_top;xp\n" +"Language-Team: Czech \n" +"Language: cs\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Používat implicitně ANSI verzi (stále ve vývoji)?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL se nachází ve fázi, kdy kromě tradičního obrazu CLtL1 (který se stále " +"používá) poskytuje i obraz kompatibilní s ANSI." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Pro stručný popis těchto termínů si prosím přečtěte soubor README.Debian. " +"Touto odpovědí určujete, který obraz se spustí po zadání „gcl@EXT@“. " + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Toto nastavení můžete přebít nastavením proměnné prostředí GCL_ANSI na " +"neprázdný řetězec (použije ANSI verzi) nebo na prázdnou hodnotu (použije " +"CLtL1 verzi). Například GCL_ANSI=t gcl@EXT@. Aktuálně použitá verze se " +"zobrazí na úvodní obrazovce." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Používat implicitně profilování?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL nyní podporuje profilování přes gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Podrobnosti naleznete v dokumentaci si::gprof-start a si::gprof-quit. Tato " +"verze je pomalejší než verze bez podpory gprof, tudíž ji nedoporučujeme pro " +"koncové produkční nasazení." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Toto nastavení můžete přebít nastavením proměnné prostředí GCL_PROF na " +"neprázdný řetězec (zapne profilování) nebo na prázdnou hodnotu (povolí lepší " +"optimalizace). Například GCL_PROF=t gcl@EXT@. Pokud je profilování zapnuto, " +"dozvíte se o tom z úvodní obrazovky." + +#~ msgid "" +#~ "GCL is one of the oldest free common lisp systems still in use. Several " +#~ "production systems have used it for over a decade. The common lisp " +#~ "standard in effect when GCL was first released is known as \"Common Lisp, " +#~ "the Language\" (CLtL1) after a book by Steele of the same name providing " +#~ "this specification. Subsequently, a much expanded standard was adopted " +#~ "by the American National Standards Institute (ANSI), which is still " +#~ "considered the definitive common lisp language specification to this " +#~ "day. GCL is in the process of providing an ANSI compliant image in " +#~ "addition to its traditional CLtL1 image still in production use. Setting " +#~ "this variable will determine which image you will use by default on " +#~ "executing 'gcl'. You can locally override this choice by setting the " +#~ "GCL_ANSI environment variable to any non-empty string for the ANSI build, " +#~ "and to the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl. You " +#~ "may be interested in reviewing the ANSI test results sketching the level " +#~ "of compliance achieved thus far in /usr/share/doc/gcl/test_results.gz. " +#~ "The flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL je jedním z nejstarších svobodných systémů common lispu, který se " +#~ "dosud používá. Několik produkčních systémů jej používá déle než dekádu. " +#~ "Při prvním vydání GCL byl v platnosti standard common lispu známý jako " +#~ "\"Common Lisp, the Language\" (CLtL1) pojmenovaný podle Steelovy knihy " +#~ "stejného jména, která tento standard definovala. Americkým národním " +#~ "institutem pro standardizaci (ANSI) pak byl přijat podstatně rozšířený " +#~ "standard, který se do dnešní doby považuje za konečnou specifikaci common " +#~ "lispu. Kromě tradičního CLtL1 se GCL snaží nabídnout i verzi odpovídající " +#~ "ANSI standardu. Nastavením této proměnné určíte, jakým způsobem se má " +#~ "binárka 'gcl' chovat. Lokálně můžete toto nastavení přepsat nastavením " +#~ "proměnné prostředí GCL_ANSI na neprázdný řetězec (zapne ANSI chování) " +#~ "nebo na prázdnou hodnotu (zapne CLtL1 chování). Například GCL_ANSI-t gcl. " +#~ "Aktuálně vybraný standard bude zobrazen v úvodní obrazovce prostředí. " +#~ "Zajímavé může být porovnání dosud dosažené shody s ANSI standardem v " +#~ "souboru /usr/share/doc/gcl/test_results.gz." diff --git a/po/da.po b/po/da.po new file mode 100644 index 00000000..11d3fc63 --- /dev/null +++ b/po/da.po @@ -0,0 +1,97 @@ +# Danish translation gcl. +# Copyright (C) 2012 gcl & nedenstående oversættere. +# This file is distributed under the same license as the gcl package. +# Joe Hansen (joedalton2@yahoo.dk), 2012. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2012-03-31 12:42+0000\n" +"Last-Translator: Joe Hansen \n" +"Language-Team: Danish \n" +"Language: da\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Brug den foreløbige ANSI bygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL er i gang med at tilbyde et ANSI-overholdende aftryk udover det " +"traditionelle CLtL1-aftryk som stadig er i produktionsbrug." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Se venligst filen README.Debian for en kort beskrivelse af disse termer. " +"Valg af denne indstilling vil bestemme hvilket aftryk som vil blive brugt " +"som standard, når der køres »gcl@EXT@«." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Denne indstilling kan overskrives ved at angive miljøvariablen GCL_ANSI til " +"enhver streng der ikke er tom for ANSI-bygningen, og til den tomme streng " +"for CLtL1-bygningen, f.eks. GCL_ANSI=t gcl@EXT@. Den aktuelt tvungne " +"byggevariant vil blive rapporteret i det oprindelige opstartsbanner." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Brug profileringen bygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL har valgfri understøttelse for profilering via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Se venligst dokumentationen for si::gprof-start og si::gprof-quit for " +"detaljer. Da denne bygning er langsommere end bygninger uden gprof-" +"understøttelse, så anbefales den ikke for endelig produktionsbrug." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Angiv miljøvariablen GCL_PROF til den tomme streng for bedre optimerede " +"bygninger, eller enhver streng der ikke er tom for " +"profileringsunderstøttelse; f.eks. GCL_PROF=t gcl@EXT@. Hvis profilering er " +"aktiveret, vil denne blive rapporteret i det oprindelige opstartsbanner." diff --git a/po/de.po b/po/de.po new file mode 100644 index 00000000..dafd73da --- /dev/null +++ b/po/de.po @@ -0,0 +1,139 @@ +# Translation of gcl debconf templates to German +# Copyright (C) Stefan Bauer , 2007. +# Copyright (C) Helge Kreutzmann , 2007, 2008. +# This file is distributed under the same license as the gcl package. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-09 11:49+0100\n" +"Last-Translator: Stefan Bauer \n" +"Language-Team: de \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-15\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Verwende standardmig den sich in Arbeit befindlichen ANSI-Build?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL ist derzeit dabei, zustzlich zu dem noch im Einsatz befindlichen " +"traditionellen CLtL1-Image ein ANSI-konformes Image bereitzustellen." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Bitte lesen Sie die Datei README.Debian fr eine kurze Beschreibung dieser " +"Begriffe. Die Wahl dieser Option bestimmen, welches Image standardmig " +"verwendet wird, wenn gcl@EXT@ ausgefhrt wird." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Diese Einstellung kann mit der Umgebungsvariablen GCL_ANSI berschrieben " +"werden. Jede nicht-leere Zeichenkette fhrt zur ANSI-Erstellung, und die " +"leere Zeichenkette fhrt zum CLtL1-Bau, z.B. GCL_ANSI=t gcl@EXT@. In der " +"Startmeldung wird die derzeit erzwungene Bauart berichtet." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Verwende standardmig den Profiling-Build?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL besitzt optionale Untersttzung fr Profiling mittels Gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Bitte lesen Sie die Dokumentation fr si::gprof-start und si::gprof-quit fr " +"Details. Da ein solches Programm langsamer ist als ein Programm ohne Gprof-" +"Untersttzung, wird dies fr den Produktiveinsatz nicht empfohlen." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Setzen Sie die Umgebungsvariable GCL_PROF auf die leere Zeichenkette, um ein " +"optimiertes Programm zu erhalten oder auf irgendeine nicht-leere " +"Zeichenkette, fr Profiling-Untersttzung; z.B. GCL_PROF=t gcl@EXT@. Falls " +"Profiling aktiviert ist, wird dies in der Startmeldung angezeigt." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL arbeitet neben dem traditionellen CLtL1-Image fr den " +#~ "Produktiveinsatz zustzlich an der Bereitstellung eines kompatiblen ANSI-" +#~ "Images. Bitte beachten Sie die README.Debian-Datei fr eine kurze " +#~ "Beschreibung dieses Themas. Durch diese Variable definieren Sie, welches " +#~ "Image voreingestellt bei der Ausfhrung von gcl@EXT@ verwendet wird. " +#~ "Diese Auswahl kann lokal, durch einen nicht leeren Wert in der " +#~ "Umgebungsvariable GCL_ANSI fr den ANSI-Build, bzw. einen leeren Wert " +#~ "fr den CLtL1-Build, z.B. GCL_ANSI=t gcl@EXT@ definiert werden. Es " +#~ "erfolgt eine Meldung ber die aktive Erstellung im einfhrenden Start-" +#~ "Banner." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "GCL besitzt optionale Untersttzung fr Profiling mit gprof. Bitte lesen " +#~ "Sie hierzu die Dokumentation von si::gprof-start und si::gprof-quit fr " +#~ "weiterfhrende Informationen. Da dieser Build langsamer ist als ohne " +#~ "gprof-Untersttzung, wird dieser Weg nicht fr den endgltig produktiven " +#~ "Einsatz empfohlen. Sie knnen die hier gemachten Angaben lokal ber die " +#~ "GCL_PROF-Umgebungsvariable durch einen beliebigen Wert ndern, bzw. durch " +#~ "einen leeren Wert fr das weitaus anpassungsfhigere Build, z.B. " +#~ "GCL_PROF=t gcl@EXT@. Falls Profiling aktiviert ist, erfolgt eine Meldung " +#~ "im einfhrenden Start-Banner." diff --git a/po/es.po b/po/es.po new file mode 100644 index 00000000..e4cb113e --- /dev/null +++ b/po/es.po @@ -0,0 +1,209 @@ +# gcl po-debconf translation to Spanish +# Copyright (C) 2005, 2007, 2008 Software in the Public Interest +# This file is distributed under the same license as the gcl package. +# +# Changes: +# - Initial translation +# César Gómez Martín , 2005 +# +# - Updates +# Rudy Godoy Guillén , 2007 +# Francisco Javier Cuadrado , 2008 +# +# Traductores, si no conoce el formato PO, merece la pena leer la +# documentación de gettext, especialmente las secciones dedicadas a este +# formato, por ejemplo ejecutando: +# +# info -n '(gettext)PO Files' +# info -n '(gettext)Header Entry' +# +# Equipo de traducción al español, por favor, lean antes de traducir +# los siguientes documentos: +# +# - El proyecto de traducción de Debian al español +# http://www.debian.org/intl/spanish/ +# especialmente las notas de traducción en +# http://www.debian.org/intl/spanish/notas +# +# - La guía de traducción de po's de debconf: +# /usr/share/doc/po-debconf/README-trans +# o http://www.debian.org/intl/l10n/po-debconf/README-trans +# +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-45\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-12-04 20:00+0100\n" +"Last-Translator: Francisco Javier Cuadrado \n" +"Language-Team: Debian l10n spanish \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=utf-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Poedit-Language: Spanish\n" +"X-Poedit-Country: SPAIN\n" +"X-Poedit-SourceCharset: utf-8\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "" +"¿Utilizar la generación ANSI todavía en desarrollo de manera predeterminada?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GL está en el proceso de proporcionar una imagen ANSI, además de su imagen " +"CLtL1 tradicional que todavía se usa." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Por favor, véase el archivo README.Debian para una descripción corta de " +"estos términos. Eligiendo esta opción determinará que imagen se usará de " +"manera predeterminada al ejecutar «gcl@EXT@»." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Esta configuración se puede sobrescribir cambiando la variable de entorno " +"GCL_ANSI a cualquier cadena de caracteres no vacía para la generación ANSI, " +"y a una cadena de caracteres vacía para la generación CLtL1, por ejemplo: " +"«GCL_ANSI=t gcl@EXT@». El actual tipo de generación se mostrará en la " +"información inicial del arranque." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "¿Utilizar la generación con «profiling» de manera predeterminada?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL permite usar «profiling», de manera opcional, mediante gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Por favor, véase la documentación para los detalles de «si::gprof-start» y " +"«si::gprof-quit». Ya que esta generación es más lenta que sin el uso de " +"gprof, no se recomienda para su uso final." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Cambie el valor de la variable de entorno GCL_PROF a una cadena de " +"caracteres vacía para generación más optimizadas, o a una cadena de " +"caracteres no vacía para usar el «profiling», por ejemplo: «GCL_PROF=t " +"gcl@EXT@». Si el «profiling» está activado, se mostrará en la información " +"inicial del arranque." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL está en proceso de incorporar una imagen compatible con ANSI en " +#~ "adición a su imagen CLtL1 tradicional que todavía se usa en producción. " +#~ "Por favor, véase el fichero README de Debian para una breve descripción " +#~ "acerca de estos términos. El definir esta variable determinará qué imagen " +#~ "utilizar de manera predeterminada cuando ejecute «gcl@EXT@».\n" +#~ "Puede anular esta elección localmente definiendo la variable de entorno " +#~ "GCL_ANSI a una cadena no vacía para la compilación ANSI, y a una vacía " +#~ "para la compilación CLtL1, ejemplo: GCL_ANSI=t gcl@EXT@. La versión de la " +#~ "compilación se indicará en el anuncio inicial de arranque." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "Ahora GCL tiene soporte opcional para perfilado a través de gprof. Por " +#~ "favor, mire la documentación de «si::gprof-start» y de «si::gprof-quit» y " +#~ "«si::gprof-quit» si desea más detalles. Dado que esta compilación es más " +#~ "lenta que otras sin soporte para gprof, no se recomienda usarlo en " +#~ "producción. Puede anular esta elección de forma local mediante el " +#~ "establecimiento de la variable de entorno GCL_PROF a cualquier cadena no " +#~ "vacía para soporte de perfiles, y a la cadena vacía para los paquetes más " +#~ "optimizados, es decir GCL_PROF=t gcl. Si el perfilado está activo se " +#~ "indicará en el anuncio inicial de arranque." + +#~ msgid "" +#~ "GCL is one of the oldest free common lisp systems still in use. Several " +#~ "production systems have used it for over a decade. The common lisp " +#~ "standard in effect when GCL was first released is known as \"Common Lisp, " +#~ "the Language\" (CLtL1) after a book by Steele of the same name providing " +#~ "this specification. Subsequently, a much expanded standard was adopted " +#~ "by the American National Standards Institute (ANSI), which is still " +#~ "considered the definitive common lisp language specification to this " +#~ "day. GCL is in the process of providing an ANSI compliant image in " +#~ "addition to its traditional CLtL1 image still in production use. Setting " +#~ "this variable will determine which image you will use by default on " +#~ "executing 'gcl'. You can locally override this choice by setting the " +#~ "GCL_ANSI environment variable to any non-empty string for the ANSI build, " +#~ "and to the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl. You " +#~ "may be interested in reviewing the ANSI test results sketching the level " +#~ "of compliance achieved thus far in /usr/share/doc/gcl/test_results.gz. " +#~ "The flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL es uno de los sistemas libres de «common lisp» más antiguos que " +#~ "todavía se usan. Varios sistemas en producción han estado usándolo " +#~ "durante más de una década. Cuando GCL se liberó por primera vez, el " +#~ "estándar «common lisp» se conocía como «Common Lisp, the " +#~ "Language» (CLtL1) después de un libro escrito por Steele que llevaba el " +#~ "mismo nombre y que proporcionaba esta especificación. Posteriormente se " +#~ "adoptó en el Instituto Nacional de Estándares Americano (ANSI) un " +#~ "estándar más extendido, que todavía se considera la especificación " +#~ "definitiva del lenguaje «common lisp» hasta hoy. GCL está en el proceso " +#~ "de proporcionar una imagen conforme a ANSI además de su imagen CltL1 " +#~ "tradicional que todavía se usa en producción. Al establecer esta variable " +#~ "se determinará la imagen por omisión que usará al ejecutar «gcl». Puede " +#~ "anular esta elección de forma local mediante el establecimiento de la " +#~ "variable de entorno GCL_ANSI a cualquier cadena no vacía para el paquete " +#~ "ANSI, y a la cadena vacía para el paquete CLtL1, i.e. GCL_ANSI=t gcl. " +#~ "Quizás esté interesado en revisar los resultados de las pruebas ANSI " +#~ "describiendo el nivel de conformidad logrado hasta ahora en /usr/share/" +#~ "doc/gcl/test_results.gz. Se informará del tipo de paquete usado en el " +#~ "anuncio inicial de arranque." diff --git a/po/fi.po b/po/fi.po new file mode 100644 index 00000000..e9dc116f --- /dev/null +++ b/po/fi.po @@ -0,0 +1,95 @@ +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-29 23:28+0200\n" +"Last-Translator: Esko Arajärvi \n" +"Language-Team: Finnish \n" +"Language: fi\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Poedit-Language: Finnish\n" +"X-Poedit-Country: Finland\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Käytetäänkö kehitettävää ANSI-käännöstä oletuksena?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL:n on tarkoitus tarjota ANSI-yhteensopiva kuva perinteisen, vielä " +"tuotantokäytössä olevan CLtL1-kuvan lisäksi." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Tiedostosta README.Debian löytyy (englanniksi) näiden termien lyhyet " +"kuvaukset. Tämä valinta vaikuttaa siihen mitä kuvaa käytetään oletuksena " +"ajettaessa ”gcl@EXT@”." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Tämä asetus voidaan ohittaa asettamalla GCL_ANSI-ympäristömuuttuja. Jos " +"muuttujan arvo on mikä tahansa ei-tyhjä merkkijono, käytetään ANSI-" +"käännöstä, ja jos muuttujan arvo on tyhjä merkkijono, käytetään CLtL1-" +"käännöstä. Esimerkiksi: GCL_ANSI=t gcl@EXT@. Käytetty pakotettu käännöstapa " +"raportoidaan käynnistysruudussa." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Käytetäänkö profilointia oletuksena?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL tukee valinnaisesti profilointia gprofin avulla." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Katso yksityiskohdat (englanniksi) dokumentaatiosta kohdista si::gprof-start " +"ja si::gprof-quit. Koska tämä käännös on hitaampi kuin käännökset ilman " +"gprof-tukea, tätä ei suositella tuotantokäyttöön." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Aseta GCL_PROF-ympäristömuuttuja tyhjäksi merkkijonoksi käyttääksesi " +"optimoidumpia käännöksiä ja miksi tahansa ei-tyhjäksi merkkijonoksi " +"käyttääksesi profilointia. Esimerkiksi: GCL_PROF=t gcl@EXT@. Jos profilointi " +"on aktivoituna, se raportoidaan käynnistysruudussa." diff --git a/po/fr.po b/po/fr.po new file mode 100644 index 00000000..0a513f44 --- /dev/null +++ b/po/fr.po @@ -0,0 +1,141 @@ +# Translation of gcl debconf templates to French +# Copyright (C) 2007 Sylvain Archenault +# This file is distributed under the same license as the iodine package. +# +# Sylvain Archenault , 2007. +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-1\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-23 13:03+0100\n" +"Last-Translator: Sylvain Archenault \n" +"Language-Team: French \n" +"Language: fr\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-15\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Faut-il utiliser la compilation ANSI par dfaut?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL est en passe de fournir une image respectant la norme ANSI en plus de " +"l'image traditionnelle CLtL1, toujours utilise en production." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Veuillez lire le fichier README.Debian pour une brve description de ces " +"termes. Le choix de cette option dterminera quelle image sera utilise par " +"dfaut en excutant gcl@EXT@." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Ce rglage peut tre chang en affectant la variable d'environnement " +"GCL_ANSI une chane non vide pour la compilation ANSI, et une chane vide " +"pour la compilation CLtL1, par exemple GCL_ANSI=t gcl@EXT@. Le type de " +"compilation sera affich dans le bandeau de dmarrage." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Faut-il utiliser le profilage par dfaut?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL permet optionnellement la gestion du profilage via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Veuillez vous reporter la documentation de si::gprof-start et si::" +"gprof-quit pour plus de dtails. Comme cet excutable est plus lent que " +"les excutables sans la gestion de gprof, il n'est pas recommand de " +"l'utiliser en production." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Veuillez affecter une chane vide la variable d'environnement GCL_PROF " +"pour des compilations optimises, ou une chane non vide pour avoir la " +"gestion du profilage; par exemple GCL_PROF=t gcl@EXT@. Si le profilage est " +"activ, cela sera affich dans le bandeau de dmarrage." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "GCL a pour but de fournir une image conforme la dfinition de " +#~ "l'ANSI en plus de son image traditionnelle CLtL1 qui est toujours " +#~ "utilise en production. Veuillez consulter le fichier README.Debian " +#~ "pour plus d'informations sur ces normes. Ce choix dterminera quelle " +#~ "norme vous allez utiliser par dfaut lors de l'excution de " +#~ "gcl@EXT@. Vous pouvez localement modifier ce choix en " +#~ "affectant une chane non vide la variable d'environnement GCL_ANSI " +#~ "pour une compilation respectant la norme dfinie par l'ANSI, et une " +#~ "chane vide pour une compilation en accord avec la norme CLtL1, par " +#~ "exemple GCL_ANSI=t gcl@EXT@. Le type de compilation sera affich dans " +#~ "le bandeau de dmarrage." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "GCL gre dsormais le profilage via gprof. Veuillez consulter la " +#~ "documentation de si::gprof-start et de si::gprof-quit pour plus " +#~ "d'informations. La construction produite avec cette option est plus lente " +#~ "que la construction classique. Par consquent il n'est pas recommand " +#~ "de l'utiliser en production. Vous pouvez localement modifier ce choix en " +#~ "affectant la variable d'environnement GCL_PROF, une chane non vide " +#~ "pour activer le profilage, ou une chane vide pour une compilation " +#~ "optimise, par exemple GCL_PROF=t gcl@EXT@. Si le profilage est " +#~ "activ, cela sera affich dans le bandeau de dmarrage." diff --git a/po/gl.po b/po/gl.po new file mode 100644 index 00000000..951ca9f0 --- /dev/null +++ b/po/gl.po @@ -0,0 +1,138 @@ +# Galician translation of gclcvs's debconf templates +# This file is distributed under the same license as the gclcvs package. +# Jacobo Tarrio , 2007. +# +msgid "" +msgstr "" +"Project-Id-Version: gclcvs\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-01 13:38+0000\n" +"Last-Translator: Jacobo Tarrio \n" +"Language-Team: Galician \n" +"Language: gl\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "¿Empregar por defecto a versión ANSI que se está a facer?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"Estase a traballar para que GCL forneza unha imaxe ANSI ademáis da imaxe " +"CLtL1 que aínda se emprega en produción." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Consulte o ficheiro README.Debian para ver unha descrición breve deses " +"termos. Ao establecer esa variable ha determinar a imaxe que ha empregar por " +"defecto ao executar \"gcl@EXT@\"." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Pode empregar a outra imaxe establecendo a variable de ambiente GCL_ANSI a " +"calquera cadea non baleira para empregar a versión ANSI, e á cadea baleira " +"para empregar a versión CLtL1; por exemplo, GCL_ANSI=t gcl@EXT@. Hase " +"informar da versión en uso no cartel que aparece ao iniciar o programa." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "¿Empregar por defecto a versión con cronometrado?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL agora ten soporte opcional de cronometrado mediante gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Consulte a documentación de si::gprof-start e si::gprof-quit para máis " +"detalles. Xa que esta versión é máis lenta que as que non teñen soporte de " +"gprof, non se recomenda que a empregue para o uso en produción." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Pode empregar unha versión distinta á seleccionada establecendo a variable " +"de ambiente GCL_PROF a calquera cadea non baleira para empregar o soporte de " +"cronometrado, ou á cadea baleira para as versións máis optimizadas; por " +"exemplo, GCL_PROF=t gcl@EXT@. Se está activado o cronometrado, hase informar " +"diso no cartel que aparece ao iniciar o programa." + +#~ msgid "" +#~ "GCL is in the process of providing an ANSI compliant image in addition to " +#~ "its traditional CLtL1 image still in production use. Please see the " +#~ "README.Debian file for a brief description of these terms. Setting this " +#~ "variable will determine which image you will use by default on executing " +#~ "'gcl@EXT@'. You can locally override this choice by setting the GCL_ANSI " +#~ "environment variable to any non-empty string for the ANSI build, and to " +#~ "the empty string for the CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The " +#~ "flavor of the build in force will be reported in the initial startup " +#~ "banner." +#~ msgstr "" +#~ "Estase a traballar para que GCL forneza unha imaxe ANSI ademáis da imaxe " +#~ "CLtL1 que aínda se emprega en produción. Consulte o ficheiro README." +#~ "Debian para ver unha descrición breve deses termos. Ao estabrecer esa " +#~ "variable ha determinar a imaxe que ha empregar por defecto ao executar " +#~ "\"gcl@EXT@\". Pode empregar a outra imaxe estabrecendo a variable de " +#~ "ambiente GCL_ANSI a calquera cadea non baleira para empregar a versión " +#~ "ANSI, e á cadea baleira para empregar a versión CLtL1; por exemplo, " +#~ "GCL_ANSI=t gcl@EXT@. Hase informar da versión en uso no cartel que " +#~ "aparece ao iniciar o programa." + +#~ msgid "" +#~ "GCL now has optional support for profiling via gprof. Please see the " +#~ "documentation for si::gprof-start and si::gprof-quit for details. As this " +#~ "build is slower than builds without gprof support, it is not recommended " +#~ "for final production use. You can locally override the default choice " +#~ "made here by setting the GCL_PROF environment variable to any non-empty " +#~ "string for profiling support, and to the empty string for the more " +#~ "optimized builds, e.g. GCL_PROF=t gcl@EXT@. If profiling is enabled, " +#~ "this will be reported in the initial startup banner." +#~ msgstr "" +#~ "GCL agora ten soporte opcional de cronometrado mediante gprof. Consulte a " +#~ "documentación de si::gprof-start e si::gprof-quit para máis detalles. Xa " +#~ "que esta versión é máis lenta que as que non teñen soporte de gprof, non " +#~ "se recomenda que a empregue para o uso en produción. Pode empregar unha " +#~ "versión distinta á seleccionada estabrecendo a variable de ambiente " +#~ "GCL_PROF a calquera cadea non baleira para empregar o soporte de " +#~ "cronometrado, ou á cadea baleira para as versións máis optimizadas; por " +#~ "exemplo, GCL_PROF=t gcl@EXT@. Se está activado o cronometrado, hase " +#~ "informar diso no cartel que aparece ao iniciar o programa." diff --git a/po/it.po b/po/it.po new file mode 100644 index 00000000..a4885612 --- /dev/null +++ b/po/it.po @@ -0,0 +1,102 @@ +# ITALIAN TRANSLATION OF GCL'S PO-DEBCONF FILE. +# COPYRIGHT (C) 2009 THE GCL'S COPYRIGHT HOLDER +# This file is distributed under the same license as the gcl package. +# +# Vincenzo Campanella , 2009. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2009-11-29 08:39+0100\n" +"Last-Translator: Vincenzo Campanella \n" +"Language-Team: Italian \n" +"Language: it\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "" +"Usare in modo predefinito la compilazione ANSI, che è in fase di " +"approntamento?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"Accanto all'immagine tradizionale CLtL1, in uso in realtà produttive, GCL " +"sta preparando un'immagine conforme ad ANSI." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Per maggiori informazioni consultare il file «README.Debian». La scelta di " +"questa opzione determinerà quale immagine verrà utilizzata in modo " +"predefinito durante l'esecuzione di «gcl@EXT@»." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Questa impostazione può essere sovrascritta impostando la variabile " +"d'ambiente «GCL_ANSI» con una stringa non vuota per la compilazione ANSI e " +"con una stringa vuota per la compilazione CLtL1, per esempio: «GCL_ANSI=t " +"gcl@EXT@». Il tipo di compilazione attualmente in uso viene mostrato nella " +"schermata di avvio." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Usare il profiling in modo predefinito?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL possiede un supporto opzionale per il profiling tramite gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Per maggiori dettagli consultare la documentazione per «si::gprof-start» e " +"«si::gprof-quit». Poiché questa compilazione è più lenta, rispetto a quella " +"senza supporto per gprof, non è raccomandata per un utilizzo in realtà " +"produttive." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Per compilazioni ottimizzate impostare la variabile d'ambiente «GCL_PROF» a " +"una stringa vuota, oppure per impostare il supporto al profiling impostarla " +"a una stringa non vuota, per esempio «GCL_PROF=t gcl@EXT@». La schermata " +"d'avvio indicherà se il profiling è abilitato." diff --git a/po/ja.po b/po/ja.po new file mode 100644 index 00000000..169782b6 --- /dev/null +++ b/po/ja.po @@ -0,0 +1,96 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the gcl package. +# victory , 2013. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2013-07-27 14:28+0000\n" +"PO-Revision-Date: 2013-07-27 23:28+0900\n" +"Last-Translator: victory \n" +"Language-Team: Japanese \n" +"Language: ja\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "未完成の ANSI ビルドをデフォルトで使用しますか?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL は未だに生産利用されている従来の CLtL1 イメージに加えて ANSI 準拠のイメー" +"ジを提供する過程にあります。" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"用語については README.Debian ファイルに簡単な説明があります。このオプションの" +"選択「gcl@EXT@」を実行するときにどのイメージをデフォルトで利用するのか決定する" +"ことになります。" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"この設定は、GCL_ANSI 環境変数に ANSI ビルドでは空白ではない任意の文字列、" +"CLtL1 ビルドでは空白文字列をセットすることで上書きできます。例えば GCL_ANSI=t " +"gcl@EXT@。現在実行しているビルドの種類は初期の開始時バナーで報告されます。" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "デフォルトで profiling ビルドを使いますか?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "" +"GCL にはオプションで gprof 経由の profiling サポートがあります。" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"詳細については si::gprof-start や si::gprof-quit の文書を見てください。このビ" +"ルドは gprof サポートのないビルドより遅いため、最終的な生産利用にはお勧めしま" +"せん。" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"ビルドをもっと最適化する場合は GCL_PROF 環境変数に空白文字列を、profiling をサ" +"ポートさせる場合は空白ではない任意の文字列をセットしてください。例えば GCL_" +"PROF=t gcl@EXT@。profiling が有効な場合、初期の開始時バナーで報告されます。" diff --git a/po/nl.po b/po/nl.po new file mode 100644 index 00000000..c46d99fb --- /dev/null +++ b/po/nl.po @@ -0,0 +1,101 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR , YEAR. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-01 21:15+0100\n" +"Last-Translator: Bart Cornelis \n" +"Language-Team: debian-l10n-dutch \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=utf-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Poedit-Language: Dutch\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Wilt u standaard de in-ontwikkeling-zijnde ansi-compilatie gebruiken?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL is bezig om, aanvullend op het traditionele CLtL1-compilatie dat nog " +"steeds in gebruik is, een aan ANSI voldoend compilatie te voorzien." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Meer informatie hierover vindt u in het bestand /usr/share/doc/gcl/README." +"Debian . Deze optie bepaalt welk compilatie standaard gebruikt wordt wanneer " +"u 'gcl@EXT@' uitvoert. " + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Deze instelling kan altijd overstegen worden door de omgevingsvariabele " +"GCL_ANSI in te stellen op een niet-lege string om de ANSI-compilatie te " +"bekomen, en op een lege string om de CLtL1-compilatie te bekomen (bv. " +"GCL_ANSI=t gcl@EXT@). De momenteel afgedwongen compilatie-soort wordt " +"weergegeven in de initiële opstartbanier." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "" +"Wilt u standaard een compilatie met ondersteuning voor profilering gebruiken?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL heeft optionele ondersteuning voor profilering via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Meer informatie vindt u in de documentatie voor si::gprof-start en si::gprof-" +"quit . Aangezien compilaties met gprof-ondersteuning trager zijn dan deze " +"zonder is dit niet aan te raden voor productie-gebruik." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Om een geoptimaliseerde compilatie te verkrijgen stelt u de " +"omgevingsvariabele GCL_PROF in op een lege string, of op een niet-lege " +"string als u profilering wilt ondersteunen (bv. GCL_PROF=t gcl@EXT@). Als " +"profilering geactiveerd is wordt dit weergegeven in de initiële " +"opstartbanier ." diff --git a/po/pt.po b/po/pt.po new file mode 100644 index 00000000..fb8b56b7 --- /dev/null +++ b/po/pt.po @@ -0,0 +1,99 @@ +# translation of gcl debconf to Portuguese +# Copyright (C) 2007 Américo Monteiro +# This file is distributed under the same license as the gcl package. +# +# Américo Monteiro , 2007. +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2007-12-23 16:44+0000\n" +"Last-Translator: Américo Monteiro \n" +"Language-Team: Portuguese \n" +"Language: pt\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: KBabel 1.11.4\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Usar a compilação 'ainda em desenvolvimento' ANSI por prédefinição? " + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL está no processo de disponibilizar uma imagem compatível com ANSI como " +"adição à sua imagem tradicional CLtL1 ainda em utilização de produção." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Por favor veja o ficheiro README.Debian para uma breve descrição destes " +"termos. Escolher esta opção irá determinar qual imagem será usada por " +"prédefinição ao executar 'gcl@EXT@'." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Esta opção pode ser sobreposta ao regular a variável de ambiente GCL_ANSI " +"para qualquer string não-vazia para a compilação ANSI, e para uma string " +"vazia para a compilação CLtL1, como por exemplo GCL_ANSI=t gcl@EXT@. O tipo " +"de compilação actualmente imposto será reportado no banner inicial de " +"arranque." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Usar, como pré-definição, a compilação com 'profiling'?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "O GCL tem suporte opcional para 'profiling' via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Por favor veja a documentação de si::gprof-start e si::gprof-quit para mais " +"detalhes. Como esta compilação é mais lenta do que as compilações sem o " +"suporte para gprof, não é recomendada para utilização de produção final." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Regule a variável de ambiente GCL_PROF para uma string vazia para mais " +"compilações optimizadas, ou para qualquer string não-vazia para suporte de " +"'profiling'; como por exemplo GCL_PROF=t gcl@EXT@. Se o 'profiling' estiver " +"activo, isto será reportado no banner inicial de arranque." diff --git a/po/pt_BR.po b/po/pt_BR.po new file mode 100644 index 00000000..74f2f037 --- /dev/null +++ b/po/pt_BR.po @@ -0,0 +1,98 @@ +# Debconf translations for gcl. +# Copyright (C) 2016 THE gcl'S COPYRIGHT HOLDER +# This file is distributed under the same license as the gcl package. +# Adriano Rafael Gomes , 2016. +# +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2016-01-05 11:09-0200\n" +"Last-Translator: Adriano Rafael Gomes \n" +"Language-Team: Brazilian Portuguese \n" +"Language: pt_BR\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Usar a versão ANSI em desenvolvimento por padrão?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"O GCL está em processo de fornecer uma imagem de acordo com o padrão ANSI em " +"adição à sua imagem CLtL1 tradicional, ainda em uso em produção." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Por favor, veja o arquivo README.Debian para uma breve descrição desses " +"termos. Escolher essa opção determinará qual imagem será usada por padrão ao " +"executar \"gcl@EXT@\"." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Essa configuração pode ser sobreposta definindo a variável de ambiente " +"GCL_ANSI para qualquer texto não vazio para a versão ANSI, e para um texto " +"vazio para a versão CLtL1, por exemplo, GCL_ANSI=t gcl@EXT@. O sabor da " +"versão atualmente definida será exibida na mensagem de inicialização." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Usar a versão de \"profiling\" por padrão?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "O GCL tem suporte opcional a \"profiling\" via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Por favor, veja a documentação para si::gprof-start e si::gprof-quit para " +"detalhes. Como essa versão é mais lenta que versões sem suporte a gprof, ela " +"não é recomendada para uso final em produção." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Defina a variável de ambiente GCL_PROF para um texto vazio para versões mais " +"otimizadas, ou para qualquer texto não vazio para ter suporte a \"profiling" +"\"; por exemplo, GCL_PROF=t gcl@EXT@. Se o \"profiling\" estiver habilitado, " +"isso será exibido na mensagem de inicialização." diff --git a/po/ru.po b/po/ru.po new file mode 100644 index 00000000..dfd56cbc --- /dev/null +++ b/po/ru.po @@ -0,0 +1,100 @@ +# translation of ru.po to Russian +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# +# Yuri Kozlov , 2008. +msgid "" +msgstr "" +"Project-Id-Version: 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-03 10:22+0300\n" +"Last-Translator: Yuri Kozlov \n" +"Language-Team: Russian \n" +"Language: ru\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: KBabel 1.11.4\n" +"Plural-Forms: nplurals=3; plural=(n%10==1 && n%100!=11 ? 0 : n%10>=2 && n" +"%10<=4 && (n%100<10 || n%100>=20) ? 1 : 2);\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Использовать разрабатываемую ANSI сборку по умолчанию?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"Помимо обычного образа CLtL1, используемого в повсеместной работе, GCL имеет " +"практически готовый образ, соответствующий ANSI." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Краткое описание приведено в файле README.Debian. Данным выбором " +"определяется, какой из образов будет использован по умолчанию при выполнении " +"'gcl@EXT@'." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Эта настройка может быть переопределена установкой переменной окружения " +"GCL_ANSI в непустое значение для ANSI сборки, а пустым значением выбирается " +"CLtL1 сборка, например GCL_ANSI=t gcl@EXT@. Текущий используемый тип сборки " +"будет показан при первом запуске." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Использовать по умолчанию профилируемую сборку?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL поддерживает необязательное профилирование через gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Подробней об этом смотрите в документации на si::gprof-start и si::gprof-" +"quit. Так как данная сборка работает медленнее чем без поддержки gprof, её " +"не рекомендуется использовать в реальной работе." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Задание переменной окружения GCL_PROF пустого значения включает более " +"оптимизированную сборку, а любое непустое -- поддержку профилирования; " +"например GCL_PROF=t gcl@EXT@. Если профилирование включено, то об этом будет " +"написано при первом запуске." diff --git a/po/sv.po b/po/sv.po new file mode 100644 index 00000000..9545624a --- /dev/null +++ b/po/sv.po @@ -0,0 +1,106 @@ +# translation of gcl_2.6.7-36.1_sv.po to Swedish +# Translators, if you are not familiar with the PO format, gettext +# documentation is worth reading, especially sections dedicated to +# this format, e.g. by running: +# info -n '(gettext)PO Files' +# info -n '(gettext)Header Entry' +# Some information specific to po-debconf are available at +# /usr/share/doc/po-debconf/README-trans +# or http://www.debian.org/intl/l10n/po-debconf/README-trans +# Developers do not need to manually edit POT or PO files. +# +# Martin gren , 2008. +msgid "" +msgstr "" +"Project-Id-Version: gcl_2.6.7-36.1_sv\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-07-24 18:21+0200\n" +"Last-Translator: Martin gren \n" +"Language-Team: Swedish \n" +"Language: sv\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=ISO-8859-1\n" +"Content-Transfer-Encoding: 8bit\n" +"X-Generator: KBabel 1.11.4\n" +"Plural-Forms: nplurals=2; plural=(n != 1);\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Anvnd det nnu inte frdiga ANSI-bygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL arbetar p att tillhandahlla en ANSI-godknd bild frutom dess " +"traditionella CLtL1-bild som fortfarande anvnds i produktionsmiljn." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Se README.Debian-filen fr en versiktlig beskrivning av dessa termer. Nr " +"du vljer det hr alternativet avgrs vilken bild som kommer anvndas som " +"standard nr 'gcl@EXT@' krs." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Denna instllning kan verskridas genom att stta miljvariabeln GCL_ANSI " +"till en icke-tom strng fr ANSI-bygget, och till den tomma strngen fr " +"CLtL1-bygget, t. ex. GCL_ANSI=t gcl@EXT@. Det bygge som fr tillfllet " +"anvnds kommer anges i uppstartsutskriften." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Anvnd profileringsbygget som standard?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL har valfritt std fr profilering via gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Se dokumentationen fr si::gprof-start och si::gprof-quit fr detaljer. " +"Eftersom detta bygge r lngsammare n byggen utan std fr gprof, " +"rekommenderas det inte fr slutlig anvndning i produktionsmilj." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Stt miljvariabeln GCL_PROF till den tomma strngen fr mer optimiserade " +"byggen, eller en icke-tom strng fr profileringsstd; t. ex. GCL_PROF=t " +"gcl@EXT@. Om profilering r aktiverad, kommer denna rapporteras i den " +"ursprungliga uppstartsutskriften." diff --git a/po/templates.pot b/po/templates.pot new file mode 100644 index 00000000..86276ce4 --- /dev/null +++ b/po/templates.pot @@ -0,0 +1,82 @@ +# SOME DESCRIPTIVE TITLE. +# Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER +# This file is distributed under the same license as the PACKAGE package. +# FIRST AUTHOR , YEAR. +# +#, fuzzy +msgid "" +msgstr "" +"Project-Id-Version: gcl\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" +"Last-Translator: FULL NAME \n" +"Language-Team: LANGUAGE \n" +"Language: \n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=CHARSET\n" +"Content-Transfer-Encoding: 8bit\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" diff --git a/po/vi.po b/po/vi.po new file mode 100644 index 00000000..d1fa6ded --- /dev/null +++ b/po/vi.po @@ -0,0 +1,98 @@ +# Vietnamese translation for GCL. +# Copyright © 2007 Free Software Foundation, Inc. +# Clytie Siddall , 2007 +# +msgid "" +msgstr "" +"Project-Id-Version: gcl 2.6.7-36\n" +"Report-Msgid-Bugs-To: gcl@packages.debian.org\n" +"POT-Creation-Date: 2012-12-30 11:53-0400\n" +"PO-Revision-Date: 2008-01-04 16:27+1030\n" +"Last-Translator: Clytie Siddall \n" +"Language-Team: Vietnamese \n" +"Language: vi\n" +"MIME-Version: 1.0\n" +"Content-Type: text/plain; charset=UTF-8\n" +"Content-Transfer-Encoding: 8bit\n" +"Plural-Forms: nplurals=1; plural=0;\n" +"X-Generator: LocFactoryEditor 1.7b1\n" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "Use the work-in-progress ANSI build by default?" +msgstr "Dùng bản xây dựng đang phát triển ANSI theo mặc định không?" + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"GCL is in the process of providing an ANSI compliant image in addition to " +"its traditional CLtL1 image still in production use." +msgstr "" +"GCL đang phát triển chức năng cung cấp ảnh tùy theo ANSI thêm vào ảnh CLtL1 " +"truyền thống vẫn còn được sử dụng trong trường hợp sản xuất." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"Please see the README.Debian file for a brief description of these terms. " +"Choosing this option will determine which image will be used by default when " +"executing 'gcl@EXT@'." +msgstr "" +"Xem tài liệu Đọc Đi (README.Debian) để tìm mô tả ngắn về các thuật ngữ này. " +"Bật tùy chọn này thì xác định ảnh nào cần dùng theo mặc định khi thực hiện " +"lệnh « gcl@EXT@ »." + +#. Type: boolean +#. Description +#: ../gcl.templates:2001 +msgid "" +"This setting may be overridden by setting the GCL_ANSI environment variable " +"to any non-empty string for the ANSI build, and to the empty string for the " +"CLtL1 build, e.g. GCL_ANSI=t gcl@EXT@. The currently enforced build flavor " +"will be reported in the initial startup banner." +msgstr "" +"Vẫn còn có thể ghi đè lên thiết lập này bằng cách đặt biến môi trường « " +"GCL_ANSI » thành bắt cứ chuỗi không rỗng cho bản xây dựng ANSI, và cho chuỗi " +"rỗng cho bản xây dựng CLtL1, v.d. « GCL_ANSI=t gcl@EXT@ ». Kiểu bản xây dựng " +"hiện thời được chọn sẽ được thông báo trên băng cờ khởi chạy đầu tiên." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "Use the profiling build by default?" +msgstr "Dùng bản xây dựng đo hiệu năng sử dụng theo mặc định không?" + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "GCL has optional support for profiling via gprof." +msgstr "GCL có hỗ trợ tùy chọn để đo hiệu năng sử dụng thông qua gprof." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Please see the documentation for si::gprof-start and si::gprof-quit for " +"details. As this build is slower than builds without gprof support, it is " +"not recommended for final production use." +msgstr "" +"Xem tài liệu hướng dẫn về « si::gprof-start » và « si::gprof-quit » để tìm " +"chi tiết. Vì bản xây dựng này chạy chậm hơn các bản xây dựng không hỗ trợ " +"gprof, không khuyên bạn sử dụng nó trong trường hợp sản xuất cuối cùng." + +#. Type: boolean +#. Description +#: ../gcl.templates:3001 +msgid "" +"Set the GCL_PROF environment variable to the empty string for more optimized " +"builds, or any non-empty string for profiling support; e.g. GCL_PROF=t " +"gcl@EXT@. If profiling is enabled, this will be reported in the initial " +"startup banner." +msgstr "" +"Đặt biến môi trường « GCL_PROF » thành chuỗi rỗng cho các bản xây dựng tối " +"ưu hơn, hoặc cho bất cứ chuỗi không rỗng nào để hỗ trợ chức năng đo hiệu " +"năng sử dụng, v.d. « GCL_PROF=t gcl@EXT@ ». Hiệu lực chức năng đo hiệu năng " +"sử dụng thì nó được thông báo trên băng cờ khởi chạy đầu tiên." diff --git a/rules b/rules new file mode 100755 index 00000000..2de2887e --- /dev/null +++ b/rules @@ -0,0 +1,271 @@ +#!/usr/bin/make -f +# Sample debian/rules that uses debhelper. +# GNU copyright 1997 by Joey Hess. +# +# This version is for a hypothetical package that builds an +# architecture-dependant package, as well as an architecture-independent +# package. + +# Uncomment this to turn on verbose mode. +#export DH_VERBOSE=1 + +export GCL_MEM_MULTIPLE=0.1 + +# This is the debhelper compatability version to use. +ARCHT:=$(shell dpkg-architecture -qDEB_HOST_ARCH) + +MCC?=gcc +# ifeq ($(ARCHT),alpha) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),mips) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),mipsel) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),ia64) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),armel) +# MCC:=gcc-4.6 +# endif +# ifeq ($(ARCHT),armhf) +# MCC:=gcc-4.6 +# endif + +#RELOC=locbfd +#RELOC?=statsysbfd +RELOC?=custreloc +ifeq ($(ARCHT),ia64) +RELOC=dlopen +endif +# ifeq ($(ARCHT),ppc64) +# RELOC=dlopen +# endif +#ifeq ($(ARCHT),hppa) +#RELOC=dlopen +#endif + +GMP?= + +DEBUG= + +#ifeq ($(ARCHT),hppa) +#DEBUG=--enable-debug +#endif + +VERS=$(shell echo $$(cat majvers).$$(cat minvers)) +#EXT:=cvs + +CFG:=$(addsuffix /config.,.)# gmp4/configfsf. +# Bug in autoconf dependency on emacsen-common workaround +#CFGS:=$(addsuffix .ori,configure $(addsuffix guess,$(CFG)) $(addsuffix sub,$(CFG))) +CFGS:=$(addsuffix .ori,$(addsuffix guess,$(CFG)) $(addsuffix sub,$(CFG))) + +$(filter %.guess.ori,$(CFGS)): %.ori: /usr/share/misc/config.guess % + ! [ -e $* ] || [ -e $@ ] || cp $* $@ + [ $$($< -t | tr -d '-') -le $$(./$* -t | tr -d '-') ] || cp $< $* + touch $@ + +$(filter %.sub.ori,$(CFGS)): %.ori: /usr/share/misc/config.sub % + ! [ -e $* ] || [ -e $@ ] || cp $* $@ + [ $$($< -t | tr -d '-') -le $$(./$* -t | tr -d '-') ] || cp $< $* + touch $@ + +configure.ori: %.ori: configure.in + ! [ -e $* ] || [ -e $@ ] || cp $* $@ + cd $(@D) && autoconf + touch $@ + +configure-%-stamp: $(CFGS) + + dh_testdir + + ! [ -e unixport/saved_pre_gcl ] || $(MAKE) clean + +# chmod -R +x gmp4/* + + [ "$*" != "trad" ] || FLAGS="--disable-ansi" ; \ + [ "$*" != "gprof" ] || FLAGS="--disable-ansi --enable-gprof" ; \ + [ "$*" != "ansi-gprof" ] || FLAGS="--enable-gprof" ; \ + eval `dpkg-buildflags --export=sh` && CC=$(MCC) ./configure \ + --host=$$(dpkg-architecture -qDEB_HOST_GNU_TYPE) \ + --disable-statsysbfd \ + --disable-custreloc \ + --disable-dlopen \ + --enable-prelink \ + --enable-$(RELOC) \ + $(GMP) \ + $(DEBUG) \ + $$FLAGS \ + --prefix=/usr \ + --mandir=\$${prefix}/share/man \ + --enable-infodir=\$${prefix}/share/info \ + --enable-emacsdir=\$${prefix}/share/emacs/site-lisp + + touch $@ + + +build-%-stamp: configure-%-stamp + dh_testdir + + $(MAKE) + + rm -rf debian/$* + mkdir -p debian/$* + $(MAKE) install DESTDIR=$$(pwd)/debian/$* + [ "$(findstring gprof,$*)" = "" ] || (\ + tmp=debian/$*; old=/usr/lib/gcl-$(VERS); new=$$old-prof;\ + if [ "$(findstring ansi,$*)" = "" ] ; then i=saved_gcl ; else i=saved_ansi_gcl ; fi;\ + mv $$tmp/$$old $$tmp/$$new ;\ + echo "(si::reset-sys-paths \"$$new/\")(si::save-system \"debian/tmp-image\")" | $$tmp/$$new/unixport/$$i &&\ + mv debian/tmp-image $$tmp/$$new/unixport/$$i;) + + touch $@ + +bclean-stamp: + $(MAKE) clean + touch $@ + +ansi-tests/test_results: build-ansi-stamp + $(MAKE) $@ + +build: build-arch build-indep +build-arch: build-stamp +build-indep: build-stamp +build-stamp: build-gprof-stamp build-ansi-gprof-stamp build-trad-stamp build-ansi-stamp ansi-tests/test_results + touch $@ + +debian/control.rm: + rm -f `echo $@ | sed 's,\.rm$$,,1'` + +debian/control: debian/control.rm + cp debian/control.$(EXT) debian/control + +clean: debian/control debian/gcl.templates + dh_testdir + dh_testroot + rm -f *stamp + debconf-updatepo + + $(MAKE) clean + + dh_clean + rm -rf debian/gprof debian/ansi-gprof debian/trad debian/ansi $(INS) debian/substvars debian.upstream + rm -rf *stamp + for i in $(CFGS) ; do ! [ -e $$i ] || mv $$i $${i%.ori} ; done + +INS:=$(shell for i in debian/in.* ; do echo $$i | sed 's,in.,,1' ; done |sed "s,gcl,gcl$(EXT),g") + +$(INS): debian/gcl$(EXT)% : debian/in.gcl% + cat $< | sed 's,@EXT@,$(EXT),g' >$@ + +install: install-stamp +install-stamp: build-stamp debian/control $(INS) + dh_testdir + dh_testroot +# dh_clean -k + dh_prep + dh_installdirs + + mkdir -p debian/tmp + cp -a debian/ansi/* debian/tmp/ + cp -a debian/trad/* debian/tmp/ + cp -a debian/gprof/* debian/tmp/ + cp -a debian/ansi-gprof/* debian/tmp/ + + mv debian/tmp/usr/share/emacs/site-lisp debian/tmp/usr/share/emacs/foo + mkdir -p debian/tmp/usr/share/emacs/site-lisp + mv debian/tmp/usr/share/emacs/foo debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT) + + cat debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/gcl.el |\ + sed "s,(provide 'gcl),(provide 'gcl$(EXT)),1" >tmp &&\ + mv tmp debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/gcl$(EXT).el + [ "$(EXT)" = "" ] || rm debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/gcl.el + + cat debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/dbl.el |\ + sed "s,(provide 'dbl),(provide 'dbl$(EXT)),1" >tmp &&\ + mv tmp debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/dbl$(EXT).el + [ "$(EXT)" = "" ] || rm debian/tmp/usr/share/emacs/site-lisp/gcl$(EXT)/dbl.el + + [ "$(EXT)" = "" ] || \ + for i in debian/tmp/usr/share/info/*.info*; do \ + mv $$i $$(echo $$i | sed "s,gcl,gcl$(EXT),g"); done + + mv debian/tmp/usr/share/doc debian/tmp/usr/share/foo + mkdir -p debian/tmp/usr/share/doc/gcl-doc + mv debian/tmp/usr/share/foo/* debian/tmp/usr/share/doc/gcl-doc + rmdir debian/tmp/usr/share/foo + + [ "$(EXT)" = "" ] || \ + mv debian/tmp/usr/share/doc/gcl-doc debian/tmp/usr/share/doc/gcl$(EXT)-doc + + [ "$(EXT)" = "" ] || \ + (cat debian/tmp/usr/share/man/man1/gcl.1 |sed -e 's, gcl , gcl$(EXT) ,g' 's, GCL , GCL$(EXT) ,g' >debian/foo && \ + mv debian/foo debian/tmp/usr/share/man/man1/gcl$(EXT).1) + + cat debian/tmp/usr/lib/gcl-$(VERS)/gcl-tk/demos/index.lsp | \ + sed "s,$$(pwd)/debian/tmp,,1" >debian/foo + mv debian/foo debian/tmp/usr/lib/gcl-$(VERS)/gcl-tk/demos/index.lsp + + rm -f debian/tmp/usr/bin/*.exe debian/tmp/usr/bin/*.bat + + find debian/tmp -type f -name "*.lsp" -exec chmod ugo-x {} \; + find debian/tmp -type f -name "*.lisp" -exec chmod ugo-x {} \; + find debian/tmp -type f -name "*.el" -exec chmod ugo-x {} \; + find debian/tmp -type f -name "*.tcl" -exec chmod ugo-x {} \; + + rm -f debian/tmp/usr/bin/gcl + TKVERS=$$(cat bin/gcl | grep /tk | head -1l | sed "s,.*/tk\([0-9.]*\)\").*,\1,1"); \ + cat debian/gcl.sh | sed -e "s,@EXT@,$(EXT),g" \ + -e "s,@VERS@,$(VERS),g" \ + -e "s,@TKVERS@,$$TKVERS,g" >debian/tmp/usr/bin/gcl$(EXT) + chmod 0755 debian/tmp/usr/bin/gcl$(EXT) + + rm -rf debian/tmp/usr/lib/gcl-$(VERS)/info + + dh_install + + touch $@ + +# Build architecture-independent files here. +# Pass -i to all debhelper commands in this target to reduce clutter. +binary-indep: build install + dh_testdir -i + dh_testroot -i + dh_installdocs -i + dh_installinfo -i + dh_installchangelogs ChangeLog -i + dh_link -i + dh_compress -i + dh_fixperms -i + dh_installdeb -i + dh_gencontrol -i + dh_md5sums -i + dh_builddeb -i + +binary-arch: build install #debian/substvars + dh_testdir -a + dh_testroot -a + dh_installdocs -a -XRELEASE-2.6.2.html + dh_installemacsen -a + dh_installman -a + dh_installdebconf -a + sed -i -e 's,@EXT@,$(EXT),g' debian/gcl$(EXT)/DEBIAN/templates + dh_installchangelogs ChangeLog -a + dh_strip -a -Xlibgcl -Xlibansi_gcl +# -Xgcl-$(VERS)-prof/unixport/saved_gcl -Xgcl-$(VERS)-prof/unixport/saved_ansi_gcl + dh_lintian -a + dh_link -a + dh_compress -a + dh_fixperms -a + dh_installdeb -a + dh_shlibdeps -a + dh_gencontrol -a -u"-Vgcc=$(MCC)" + dh_md5sums -a + dh_builddeb -a + +binary: binary-indep binary-arch +.PHONY: build clean binary-indep binary-arch binary install configure +.PRECIOUS: configure-trad-stamp configure-ansi-stamp configure-gprof-stamp configure-ansi-gprof-stamp diff --git a/source/format b/source/format new file mode 100644 index 00000000..163aaf8d --- /dev/null +++ b/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/source/include-binaries b/source/include-binaries new file mode 100644 index 00000000..f95b9a3e --- /dev/null +++ b/source/include-binaries @@ -0,0 +1,4 @@ +info/gcl-si.pdf +info/gcl-tk.pdf +xgcl-2/dwdoc.pdf +unixport/ff diff --git a/texi.awk b/texi.awk new file mode 100755 index 00000000..ccf9cdbe --- /dev/null +++ b/texi.awk @@ -0,0 +1,27 @@ +#!/usr/bin/awk -f + +/^@defun/ { + a=split($0,A,"("); + b=split($0,B,")"); + if (a==b) + print ; + else { + i=1; + c=$0; + } + next; +} +{ + if (i) { + sub("^ *",""); + c=c " " $0; + a=split(c,A,"("); + b=split(c,B,")"); + if (a==b) { + print c; + c=""; + i=0; + } + } else + print; +} diff --git a/upstream/signing-key.asc b/upstream/signing-key.asc new file mode 100644 index 00000000..741d3145 --- /dev/null +++ b/upstream/signing-key.asc @@ -0,0 +1,88 @@ +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v1 + +mQGiBD1mWk0RBADdQYIiaNJJOHAZdBpzOBm31v5AlQa1jjYx1W6zKd+ECqZVdonw +e+CP/qpVCUXRYmQ3v/ZYpINtcRR2IckTQCs4fvYUAuQir2cpKmRqImnGhzFJ1pd9 +Rf2aqPspycMx9IlqKkeY1LwNahitQ93YwyCT1HUCTB0hIuNMtFNte18DpwCgwbYP +bBuLYCG/8g+MqoG7SBhN4hkEANafxrX2EEwUCpQlKGkw4P18wCinbs7tjgXwL7SK +WV9qpIDkUEnW2cnzfDBrNW24LtHt0qMsGa8sCJW30ZPUv0sebsyzVTJR0O5g6Lpi +zlznB1LtmbkDdd79R4Qrs01k+2OK2K0r54xnOlL+ZZQFamP3jvTZAKxyUGI2Fiqu +1O7OA/4xp5/WNyuIUWUho+nfhp0sakzAiC1aBHLtAvhL470sBm3xojM6w3vicTT2 +7rnzS1teeUnCOMK+CUzzITXHrnljCkyg8d6QqtlWJCc4T6tTYJNOuWte3AckYDaF +4HhJbwNamrDGKQJ0kYOqtquz5WE8EjkxwglRQSrGanxMXnCsB7QgQ2FtbSBNYWd1 +aXJlIDxjYW1tQGVuaGFuY2VkLmNvbT6IXwQTEQIAFwUCPWZaTQULBwoDBAMVAwID +FgIBAheAABIJEHMxtcBX8EXcB2VHUEcAAQFCkQCeL84DKju0u23VHI2a9S3CZwpw +cEMAn03Jgjje37YEbLCnfh/JN4zhcUeFiQCVAwUQPXktv1RjAAQhp2rpAQEynwP5 +AZT5Fmlc6FbnVeusUNz1jtEKysdFc7TBFZSdWK2ftjuQiiiYgLOSM6kLpc6DJxLU +0gc6FmQCme1G3wnQFpi5GXFlYcW5mfe3V5/0Paxcc/CijULb4IRU41KO3tTy7wpY +NARRB5I+MeLT39bpqljO0b7PRETncVnXgkm5PEJGV3C0HkNhbW0gTWFndWlyZSA8 +Y2FtbUBkZWJpYW4ub3JnPohgBBMRAgAgBQJJmevSAhsjBgsJCAcDAgQVAggDBBYC +AwECHgECF4AACgkQczG1wFfwRdxZywCeLfMYW3CQAi8e0C8NAauuIpZJx+wAoJAW +eBe0arj/lrwecpn26l63nC5KuQENBD1mWk4QBADRBvXyQ0uxFCkac7ZVSuwEJrbw +NdhS3ossQi+gm8aDPSokKFASs75SLNQMfIRhyToGcyplP75OYaMxvyih7DFGBLoB +kzCuhBJ09VgLC0BiuJAtEI5orQf9sNt7CwBEG2KZ/X4oHXmKitgP0F4xff9XociT +ZusPI90z9yg2treJ4wADBQP/aDZ839IYpwL6ZDZ8faVtgMz65lKaFkLzi/2pHWao +SEWYiGcLozizNt+w+qcyMGUDNkDMtTY0Y9cbC8Dn7r/0/CZW1UQ2D3fSeAfsgxEE +PnYYFiFr0Xyi+oDu7fkcV9wQdqLZ6OvR0SZqoJwLdmJqjTzz1TJTOfdTcSV/+POJ +qCuITgQYEQIABgUCPWZaTgASCRBzMbXAV/BF3AdlR1BHAAEBn/kAn2saGr0hmMfO +Nn4j36onyp18oNqYAKCTJZU26kWZcORo+FbyOMQ3+Yd8EZkBogQ6A9NcEQQAiUvw +61oHv/VZvl8uo5hTAaka2HEfECf5aMvG7N1ytUXzKTldnyEBGiqOdbLtF1wL2SUV +rdhX0VhH0fi19K2graTGqSQYzdA7uIIOQHOAZ5py5mKQr9zFkKyf5W4RKAbTIUAS +uTlSy1NiyKPMXdBlu0f5rkl/m5KODlf1nVtDposAoPuMTY9/D/cOqzB4fmEQ6gMG +M2/PA/9nHj4Mow5EkvSLsuAkn/mpI0Rv+ly1pmKJtbsJZIs1PWk/J47TRVigUgft +LOlfYMAHXwfF6svodOKF0eOaBjeZmyu1KnDDy9EWWhZwdoT08AD664/bbN1goNzE +XFlfD83yPWa1VrPNME2fq6jdY/WKZB5+viKu7yaMGGwQfjg9EwP/QCbz4cZvUiF5 +SmlI3u8+wgThk3DXnL9L3GlOASacET6wRFX6C3HYnRBTB0EypYJoUPIj7rt/Ptyl +CRHQtMUuSouyq/Smj5ybw8kvGRRH4SgfoghjL+q+sVGwIZiUQXu+g96vSSBuQTE2 +x8iZ8mXpPud7jjMc98CfjiB9/ujnqK+0MEVyaWMgU2hhcmtleSA8c2hhcmtleUBz +dXBlcmsucGh5c2ljcy5zdW55c2IuZWR1PohfBBMRAgAXBQI6A9NcBQsHCgMEAxUD +AgMWAgECF4AAEgkQclUlAyIk+rwHZUdQRwABAcGdAJ45RrdVItJxXhDiCWeXpHKq +DfkBIQCg97TpqcIbuDGD1r8gkSb6ErXA+4SJAJUDBRA6L65Bj/xAXv1aZ80BAVlU +A/oD8wBcQeTD3HzeBcK6SVygQZlQS2g8v7H4G91Fu9yTESbDdYLjmybniGwTgS7q +0/RbQDRCmh+fyBD38CmB2B23VdpXRYaChDeKTP+Lvg+mQn9zdMFkERD2/W40+TID +1g7lafk3XDe+dOX59Ie0qeCXcccsv8OfhJwoEwHKPC9ZeIhGBBARAgAGBQI87l/I +AAoJEHIxQb2lt4IBM5MAnj9wqSGdaLTfHAQb7xk36abh0vboAJwIGkIMfE7HkvbX +9nXqefmNfrns3IhGBBARAgAGBQI9eSPnAAoJEHMxtcBX8EXcnq8An2DneOdg2qBr +xF5ZBzEfGBcZHMbCAJ0Z+QKVo1/XQUVcHbGrHo+kF4IfmrQhRXJpYyBTaGFya2V5 +IDxzaGFya2V5QGRlYmlhbi5vcmc+iF8EExECABcFAjo5dzoFCwcKAwQDFQMCAxYC +AQIXgAASCRByVSUDIiT6vAdlR1BHAAEBo0MAoKXjeu7EYrx9uSrlC6rQHavvmq1u +AJsFXSfzM+lgT5lO9a3K0/N+Wr4ZRIhGBBARAgAGBQI87l/fAAoJEHIxQb2lt4IB +8BgAn3ZJz4t/JBnRhEB2I0BA5CiIxKtAAKCf5FHs+3/1vYmhtAX3ouSWyN0jFIhG +BBARAgAGBQI9eSPtAAoJEHMxtcBX8EXci7YAnRnwG8BddR4vdcvNGewRxCxweOrz +AKCgcm8lYWrd0Ubz4/CtelbxA16yV7kBDQQ6A9NrEAQAyXOKw6Zg+VjOiw10ZKtP +mQNmkEA5qUcGgcXKIPwwZ8sMZLzsqzdSM6UVwlN/1D/kH9U5Lkh1LqUxQ+NVC5Qm +bGV+Wq52I9id/lpYycfxNkjURk/wXnOdFCY55pJiS2851DiCBpNC/ClFZZe1Yhdd +HhUFnJrGRjaKTMoKI3sWUDsAAwYEAIuBP5eMx8I4qzVrt9tgDEx9LZZyd18jqC42 +FcMesLMdUi/UKOzrSr/tQ/eiOVMai/RUMmtoyvJzm6bt4UsO54Ynhhul4ySreB4h +4TA7C9vKYTvPmZ5hsOAmguhtvkGOiN+7cXUa35xpL1dbBjelJR8cSFJtAQn2PKkJ +JeS6N4LHiE4EGBECAAYFAjoD02sAEgkQclUlAyIk+rwHZUdQRwABAS1yAJwO6YAP +f1tU5MvrXRbHC52/dn82kgCgkxPi+HiFgqOc1FCfMByu9ZvzwGaZAaIEPKkVqhEE +AMqWl8BYusXdZEt7EE7gDfTtYgCCREiy3B2jTERJ4DXP0hPQDxBOQh6AW0JCtcxT +vuNOZnAlMqXKPvV4tc55dSYTBYW6U2ySN+xrHi9GvS9k5JjpsZdstS5MVkTppOS0 +nTEBw8KofAHBfFpwisCsz38P5ehLnbpm1M7WNXGxmvDTAKDFxuwQL9S8gRUhXIS3 +kAOkDW2eTwP+I5Xil4aIAUnw/JVUaP7wRGUYnFnIisgPftZ+k+R/RfirSlnpPMZr +cqC8JpR0Zm2jQ7jSzTdjj4yFM0PTdUg3mUo5IANd31XshDO7utppX8QBQ9c9PYml +PSVZTRLiDT50HB4rjsoLTlYQOMsFxG4v9v6ybKCvhmZRvD1J97Q5EEsD/3V+Kor5 +8j72RZwrjTspT7roljxyly5D/p6dqiNFLOHjjfuj3SYah7TAlAxtb7CFGsPdNJJf +jZvb//IzZw7XNG1EU9+PaV6mbTZNbrXavbKrIkz6AnLB9GDFE1oDWv7c2b5v5HVv +SO/hakFEDcgxSPzkMVkc7wGOq+6kClG8z2DMtC1CcmlhbiBSIEZ1cnJ5IChUcnVz +dCBObyBPbmUpIDxmYnJpYW5AbmFjLm5ldD6IZQQTEQIAHQUCPKkVqgUJBaOagAUL +BwoDBAMVAwIDFgIBAheAABIJEHIxQb2lt4IBB2VHUEcAAQHvmwCfV6KEnp4tIKHz +dZwBGsqnlKSBkpcAmgNdv300le8RtsGdhsDCRT6cUl1TiEYEEBECAAYFAjzqw3EA +CgkQclUlAyIk+rw0sgCg6jCNQKL71DqAifPm6o07tkkYoc0An3duMoIdm9g2qV2d +OSOpJn63WXKoiEYEEBECAAYFAj15JjIACgkQczG1wFfwRdyRHQCeK2xhxX1ccxDG +DzMYZKivG5uUdBoAnRJ62vbPCyQ1I9ihAf1nzygCdxrytC1CcmlhbiBSIEZ1cnJ5 +IChUcnVzdCBObyBPbmUpIDxiZnVycnlAbmFjLm5ldD6IZQQTEQIAHQUCPUsJiQUJ +BaOagAULBwoDBAMVAwIDFgIBAheAABIJEHIxQb2lt4IBB2VHUEcAAQHzcACfeVya +lc6NRe3Kle9aX9AXxljfdnUAniXqub/sS6WetxJwKrivk3WhyQnEiEYEEBECAAYF +Aj15JjgACgkQczG1wFfwRdxRyACgv7su7KfZvI07M31IcMtS0PHL4L4AoL5wr/os +n198CXGT8C5eXCRBVa8zuQENBDypFbgQBAC3VMeu+Qsa4IlZzzvFeB9sbnIr7e6P +TWuTR3EUnOzEd/h5k/bDdLW11uDnXyhbMSOXzGJaB9HbW5NXUuHIzTEwDzP+/hSJ +HNhc3YXREOs4YMrexeTgKEE3RFJ/ulTJ2EvTVdb7+uwKEMctKC+xaK/cIiRZt8Fg +Da1KjYBnpr5DvwADBQP5AaCubKcP0z202ys6EuvY/xIgYxJ95x/ermkV91cur7e1 +J9NqLOdbgj/yLcco9T92IBMm7zAnzDEtPC7UaqvrtuISvWc+z48Lk19AN7JOOH+g +2oIvspF4Gj2RVc7vijh7gMav5tIflZxqNi2U/QFYqgVTnE0facclV3w2IpMPUpyI +VAQYEQIADAUCPKkVuAUJBaOagAASCRByMUG9pbeCAQdlR1BHAAEB+GUAn0etwV2m +fUKduxyMlCzpoCtLBzy3AJ99bcVPGhgGkpMktMMRlLjPXiLgGA== +=tBlv +-----END PGP PUBLIC KEY BLOCK----- diff --git a/watch b/watch new file mode 100644 index 00000000..4daeb724 --- /dev/null +++ b/watch @@ -0,0 +1,2 @@ +version=2 +options=pasv,pgpsigurlmangle=s/$/.sig/ ftp://ftp.gnu.org/pub/gnu/gcl gcl-([0-9.]*).tar.gz debian uupdate -- 2.30.2